00001
00002
00003
00004
00005
00006 #ifdef __cplusplus
00007 extern "C" {
00008 #endif
00009 #include "f2c.h"
00010
00011
00012
00013 static integer c__2 = 2;
00014
00015 int d07hre_(integer *ndim, integer *wtleng, doublereal *w,
00016 doublereal *g, doublereal *errcof, doublereal *rulpts)
00017 {
00018
00019 integer g_dim1, g_offset, i__1, i__2;
00020 doublereal d__1, d__2;
00021
00022
00023 integer pow_ii(integer *, integer *);
00024 double sqrt(doublereal);
00025
00026
00027 static integer i__, j;
00028 static doublereal lam0, lam1, lam2, lamp, ratio, twondm;
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082 --rulpts;
00083 g_dim1 = *ndim;
00084 g_offset = 1 + g_dim1;
00085 g -= g_offset;
00086 w -= 6;
00087 --errcof;
00088
00089
00090 i__1 = *wtleng;
00091 for (j = 1; j <= i__1; ++j) {
00092 i__2 = *ndim;
00093 for (i__ = 1; i__ <= i__2; ++i__) {
00094 g[i__ + j * g_dim1] = 0.;
00095
00096 }
00097 for (i__ = 1; i__ <= 5; ++i__) {
00098 w[i__ + j * 5] = 0.;
00099
00100 }
00101 rulpts[j] = (doublereal) (*ndim << 1);
00102
00103 }
00104 twondm = (doublereal) pow_ii(&c__2, ndim);
00105 rulpts[*wtleng] = twondm;
00106 rulpts[*wtleng - 1] = (doublereal) ((*ndim << 1) * (*ndim - 1));
00107 rulpts[1] = 1.;
00108
00109
00110
00111 lam0 = (float).4707;
00112 lamp = (float).5625;
00113 lam1 = 4 / (15 - 5 / lam0);
00114 ratio = (1 - lam1 / lam0) / 27;
00115 lam2 = (5 - lam1 * 7 - ratio * 35) / (7 - lam1 * 35 / 3 - ratio * 35 /
00116 lam0);
00117
00118
00119
00120
00121 d__1 = lam0 * 3;
00122 w[31] = 1 / (d__1 * (d__1 * d__1)) / twondm;
00123
00124 d__1 = lam1;
00125 w[26] = (1 - lam0 * 5 / 3) / ((lam1 - lam0) * 60 * (d__1 * d__1));
00126 w[16] = (1 - lam2 * 5 / 3 - twondm * 5 * w[31] * lam0 * (lam0 - lam2)) / (
00127 lam1 * 10 * (lam1 - lam2)) - (*ndim - 1 << 1) * w[26];
00128 w[11] = (1 - lam1 * 5 / 3 - twondm * 5 * w[31] * lam0 * (lam0 - lam1)) / (
00129 lam2 * 10 * (lam2 - lam1));
00130
00131
00132
00133
00134 d__1 = lam0;
00135 w[32] = 1 / (d__1 * (d__1 * d__1) * 36) / twondm;
00136
00137 d__1 = lam0;
00138
00139 d__2 = lam1;
00140 w[27] = (1 - twondm * 9 * w[32] * (d__1 * d__1)) / (d__2 * d__2 * 36);
00141 w[17] = (1 - lam2 * 5 / 3 - twondm * 5 * w[32] * lam0 * (lam0 - lam2)) / (
00142 lam1 * 10 * (lam1 - lam2)) - (*ndim - 1 << 1) * w[27];
00143 w[12] = (1 - lam1 * 5 / 3 - twondm * 5 * w[32] * lam0 * (lam0 - lam1)) / (
00144 lam2 * 10 * (lam2 - lam1));
00145
00146 d__1 = lam0;
00147 w[33] = 5 / (d__1 * (d__1 * d__1) * 108) / twondm;
00148
00149 d__1 = lam0;
00150
00151 d__2 = lam1;
00152 w[28] = (1 - twondm * 9 * w[33] * (d__1 * d__1)) / (d__2 * d__2 * 36);
00153 w[18] = (1 - lamp * 5 / 3 - twondm * 5 * w[33] * lam0 * (lam0 - lamp)) / (
00154 lam1 * 10 * (lam1 - lamp)) - (*ndim - 1 << 1) * w[28];
00155 w[23] = (1 - lam1 * 5 / 3 - twondm * 5 * w[33] * lam0 * (lam0 - lam1)) / (
00156 lamp * 10 * (lamp - lam1));
00157
00158 d__1 = lam0;
00159 w[34] = 1 / (d__1 * (d__1 * d__1) * 54) / twondm;
00160
00161 d__1 = lam0;
00162
00163 d__2 = lam1;
00164 w[29] = (1 - twondm * 18 * w[34] * (d__1 * d__1)) / (d__2 * d__2 * 72);
00165 w[19] = (1 - lam2 * 10 / 3 - twondm * 10 * w[34] * lam0 * (lam0 - lam2)) /
00166 (lam1 * 20 * (lam1 - lam2)) - (*ndim - 1 << 1) * w[29];
00167 w[14] = (1 - lam1 * 10 / 3 - twondm * 10 * w[34] * lam0 * (lam0 - lam1)) /
00168 (lam2 * 20 * (lam2 - lam1));
00169
00170
00171
00172 lam0 = sqrt(lam0);
00173 lam1 = sqrt(lam1);
00174 lam2 = sqrt(lam2);
00175 lamp = sqrt(lamp);
00176 i__1 = *ndim;
00177 for (i__ = 1; i__ <= i__1; ++i__) {
00178 g[i__ + *wtleng * g_dim1] = lam0;
00179
00180 }
00181 g[(*wtleng - 1) * g_dim1 + 1] = lam1;
00182 g[(*wtleng - 1) * g_dim1 + 2] = lam1;
00183 g[(*wtleng - 4) * g_dim1 + 1] = lam2;
00184 g[(*wtleng - 3) * g_dim1 + 1] = lam1;
00185 g[(*wtleng - 2) * g_dim1 + 1] = lamp;
00186
00187
00188
00189
00190
00191 w[6] = twondm;
00192 for (j = 2; j <= 5; ++j) {
00193 i__1 = *wtleng;
00194 for (i__ = 2; i__ <= i__1; ++i__) {
00195 w[j + i__ * 5] -= w[i__ * 5 + 1];
00196 w[j + 5] -= rulpts[i__] * w[j + i__ * 5];
00197
00198 }
00199
00200 }
00201 i__1 = *wtleng;
00202 for (i__ = 2; i__ <= i__1; ++i__) {
00203 w[i__ * 5 + 1] = twondm * w[i__ * 5 + 1];
00204 w[6] -= rulpts[i__] * w[i__ * 5 + 1];
00205
00206 }
00207
00208
00209
00210 errcof[1] = 5.;
00211 errcof[2] = 5.;
00212 errcof[3] = 1.;
00213 errcof[4] = 5.;
00214 errcof[5] = (float).5;
00215 errcof[6] = (float).25;
00216
00217
00218
00219 return 0;
00220 }
00221
00222 #ifdef __cplusplus
00223 }
00224 #endif