00001 /* dinhre.f -- translated by f2c (version 20030320). 00002 You must link the resulting object file with the libraries: 00003 -lf2c -lm (in that order) 00004 */ 00005 00006 #ifdef __cplusplus 00007 extern "C" { 00008 #endif 00009 #include "f2c.h" 00010 00011 /* Table of constant values */ 00012 00013 static integer c__2 = 2; 00014 00015 /* Subroutine */ int dinhre_(integer *ndim, integer *key, integer *wtleng, 00016 doublereal *w, doublereal *g, doublereal *errcof, doublereal *rulpts, 00017 doublereal *scales, doublereal *norms) 00018 { 00019 /* System generated locals */ 00020 integer g_dim1, g_offset, i__1, i__2; 00021 doublereal d__1; 00022 00023 /* Builtin functions */ 00024 integer pow_ii(integer *, integer *); 00025 00026 /* Local variables */ 00027 static integer i__, j, k; 00028 static doublereal we[14]; 00029 extern /* Subroutine */ int d113re_(integer *, doublereal *, doublereal *, 00030 doublereal *, doublereal *), d132re_(integer *, doublereal *, 00031 doublereal *, doublereal *, doublereal *), d07hre_(integer *, 00032 integer *, doublereal *, doublereal *, doublereal *, doublereal *) 00033 , d09hre_(integer *, integer *, doublereal *, doublereal *, 00034 doublereal *, doublereal *); 00035 00036 /* ***BEGIN PROLOGUE DINHRE */ 00037 /* ***PURPOSE DINHRE computes abscissas and weights of the integration */ 00038 /* rule and the null rules to be used in error estimation. */ 00039 /* These are computed as functions of NDIM and KEY. */ 00040 /* ***DESCRIPTION DINHRE will for given values of NDIM and KEY compute or */ 00041 /* select the correct values of the abscissas and */ 00042 /* corresponding weights for different */ 00043 /* integration rules and null rules and assign them to */ 00044 /* G and W. */ 00045 /* The heuristic error coefficients ERRCOF */ 00046 /* will be computed as a function of KEY. */ 00047 /* Scaling factors SCALES and normalization factors NORMS */ 00048 /* used in the error estimation are computed. */ 00049 00050 00051 /* ON ENTRY */ 00052 00053 /* NDIM Integer. */ 00054 /* Number of variables. */ 00055 /* KEY Integer. */ 00056 /* Key to selected local integration rule. */ 00057 /* WTLENG Integer. */ 00058 /* The number of weights in each of the rules. */ 00059 00060 /* ON RETURN */ 00061 00062 /* W Real array of dimension (5,WTLENG). */ 00063 /* The weights for the basic and null rules. */ 00064 /* W(1,1), ...,W(1,WTLENG) are weights for the basic rule. */ 00065 /* W(I,1), ...,W(I,WTLENG), for I > 1 are null rule weights. */ 00066 /* G Real array of dimension (NDIM,WTLENG). */ 00067 /* The fully symmetric sum generators for the rules. */ 00068 /* G(1,J),...,G(NDIM,J) are the generators for the points */ 00069 /* associated with the the Jth weights. */ 00070 /* ERRCOF Real array of dimension 6. */ 00071 /* Heuristic error coefficients that are used in the */ 00072 /* error estimation in BASRUL. */ 00073 /* It is assumed that the error is computed using: */ 00074 /* IF (N1*ERRCOF(1) < N2 and N2*ERRCOF(2) < N3) */ 00075 /* THEN ERROR = ERRCOF(3)*N1 */ 00076 /* ELSE ERROR = ERRCOF(4)*MAX(N1, N2, N3) */ 00077 /* ERROR = ERROR + EP*(ERRCOF(5)*ERROR/(ES+ERROR)+ERRCOF(6)) */ 00078 /* where N1-N3 are the null rules, EP is the error for */ 00079 /* the parent */ 00080 /* subregion and ES is the error for the sibling subregion. */ 00081 /* RULPTS Real array of dimension WTLENG. */ 00082 /* A work array containing the number of points produced by */ 00083 /* each generator of the selected rule. */ 00084 /* SCALES Real array of dimension (3,WTLENG). */ 00085 /* Scaling factors used to construct new null rules, */ 00086 /* N1, N2 and N3, */ 00087 /* based on a linear combination of two successive null rules */ 00088 /* in the sequence of null rules. */ 00089 /* NORMS Real array of dimension (3,WTLENG). */ 00090 /* 2**NDIM/(1-norm of the null rule constructed by each of */ 00091 /* the scaling factors.) */ 00092 00093 /* ***ROUTINES CALLED D132RE,D113RE,D07HRE,D09HRE */ 00094 /* ***END PROLOGUE DINHRE */ 00095 00096 /* Global variables. */ 00097 00098 00099 /* Local variables. */ 00100 00101 00102 /* ***FIRST EXECUTABLE STATEMENT DINHRE */ 00103 00104 /* Compute W, G and ERRCOF. */ 00105 00106 /* Parameter adjustments */ 00107 norms -= 4; 00108 scales -= 4; 00109 --rulpts; 00110 g_dim1 = *ndim; 00111 g_offset = 1 + g_dim1; 00112 g -= g_offset; 00113 w -= 6; 00114 --errcof; 00115 00116 /* Function Body */ 00117 if (*key == 1) { 00118 d132re_(wtleng, &w[6], &g[g_offset], &errcof[1], &rulpts[1]); 00119 } else if (*key == 2) { 00120 d113re_(wtleng, &w[6], &g[g_offset], &errcof[1], &rulpts[1]); 00121 } else if (*key == 3) { 00122 d09hre_(ndim, wtleng, &w[6], &g[g_offset], &errcof[1], &rulpts[1]); 00123 } else if (*key == 4) { 00124 d07hre_(ndim, wtleng, &w[6], &g[g_offset], &errcof[1], &rulpts[1]); 00125 } 00126 00127 /* Compute SCALES and NORMS. */ 00128 00129 for (k = 1; k <= 3; ++k) { 00130 i__1 = *wtleng; 00131 for (i__ = 1; i__ <= i__1; ++i__) { 00132 if (w[k + 1 + i__ * 5] != 0.) { 00133 scales[k + i__ * 3] = -w[k + 2 + i__ * 5] / w[k + 1 + i__ * 5] 00134 ; 00135 } else { 00136 scales[k + i__ * 3] = 100.; 00137 } 00138 i__2 = *wtleng; 00139 for (j = 1; j <= i__2; ++j) { 00140 we[j - 1] = w[k + 2 + j * 5] + scales[k + i__ * 3] * w[k + 1 00141 + j * 5]; 00142 /* L30: */ 00143 } 00144 norms[k + i__ * 3] = 0.; 00145 i__2 = *wtleng; 00146 for (j = 1; j <= i__2; ++j) { 00147 norms[k + i__ * 3] += rulpts[j] * (d__1 = we[j - 1], abs(d__1) 00148 ); 00149 /* L40: */ 00150 } 00151 norms[k + i__ * 3] = pow_ii(&c__2, ndim) / norms[k + i__ * 3]; 00152 /* L50: */ 00153 } 00154 /* L100: */ 00155 } 00156 return 0; 00157 00158 /* ***END DINHRE */ 00159 00160 } /* dinhre_ */ 00161 00162 #ifdef __cplusplus 00163 } 00164 #endif