00001 /* dfshre.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 /* Subroutine */ int dfshre_(integer *ndim, doublereal *center, doublereal * 00012 hwidth, doublereal *x, doublereal *g, integer *numfun, S_fp funsub, 00013 doublereal *fulsms, doublereal *funvls) 00014 { 00015 /* System generated locals */ 00016 integer i__1, i__2; 00017 00018 /* Local variables */ 00019 static integer i__, j, l; 00020 static doublereal gi, gl; 00021 static integer ixchng, lxchng; 00022 00023 /* ***BEGIN PROLOGUE DFSHRE */ 00024 /* ***KEYWORDS fully symmetric sum */ 00025 /* ***PURPOSE To compute fully symmetric basic rule sums */ 00026 /* ***AUTHOR Alan Genz, Computer Science Department, Washington */ 00027 /* State University, Pullman, WA 99163-1210 USA */ 00028 /* ***LAST MODIFICATION 88-04-08 */ 00029 /* ***DESCRIPTION DFSHRE computes a fully symmetric sum for a vector */ 00030 /* of integrand values over a hyper-rectangular region. */ 00031 /* The sum is fully symmetric with respect to the center of */ 00032 /* the region and is taken over all sign changes and */ 00033 /* permutations of the generators for the sum. */ 00034 00035 /* ON ENTRY */ 00036 00037 /* NDIM Integer. */ 00038 /* Number of variables. */ 00039 /* CENTER Real array of dimension NDIM. */ 00040 /* The coordinates for the center of the region. */ 00041 /* HWIDTH Real Array of dimension NDIM. */ 00042 /* HWIDTH(I) is half of the width of dimension I of the region. */ 00043 /* X Real Array of dimension NDIM. */ 00044 /* A work array. */ 00045 /* G Real Array of dimension NDIM. */ 00046 /* The generators for the fully symmetric sum. These MUST BE */ 00047 /* non-negative and non-increasing. */ 00048 /* NUMFUN Integer. */ 00049 /* Number of components for the vector integrand. */ 00050 /* FUNSUB Externally declared subroutine. */ 00051 /* For computing the components of the integrand at a point X. */ 00052 /* It must have parameters (NDIM, X, NUMFUN, FUNVLS). */ 00053 /* Input Parameters: */ 00054 /* X Real array of dimension NDIM. */ 00055 /* Defines the evaluation point. */ 00056 /* NDIM Integer. */ 00057 /* Number of variables for the integrand. */ 00058 /* NUMFUN Integer. */ 00059 /* Number of components for the vector integrand. */ 00060 /* Output Parameters: */ 00061 /* FUNVLS Real array of dimension NUMFUN. */ 00062 /* The components of the integrand at the point X. */ 00063 /* ON RETURN */ 00064 00065 /* FULSMS Real array of dimension NUMFUN. */ 00066 /* The values for the fully symmetric sums for each component */ 00067 /* of the integrand. */ 00068 /* FUNVLS Real array of dimension NUMFUN. */ 00069 /* A work array. */ 00070 00071 /* ***ROUTINES CALLED: FUNSUB */ 00072 00073 /* ***END PROLOGUE DFSHRE */ 00074 00075 /* Global variables. */ 00076 00077 00078 /* Local variables. */ 00079 00080 00081 /* ***FIRST EXECUTABLE STATEMENT DFSHRE */ 00082 00083 /* Parameter adjustments */ 00084 --g; 00085 --x; 00086 --hwidth; 00087 --center; 00088 --funvls; 00089 --fulsms; 00090 00091 /* Function Body */ 00092 i__1 = *numfun; 00093 for (j = 1; j <= i__1; ++j) { 00094 fulsms[j] = 0.; 00095 /* L10: */ 00096 } 00097 00098 /* Compute centrally symmetric sum for permutation of G */ 00099 00100 L20: 00101 i__1 = *ndim; 00102 for (i__ = 1; i__ <= i__1; ++i__) { 00103 x[i__] = center[i__] + g[i__] * hwidth[i__]; 00104 /* L30: */ 00105 } 00106 L40: 00107 (*funsub)(ndim, &x[1], numfun, &funvls[1]); 00108 i__1 = *numfun; 00109 for (j = 1; j <= i__1; ++j) { 00110 fulsms[j] += funvls[j]; 00111 /* L50: */ 00112 } 00113 i__1 = *ndim; 00114 for (i__ = 1; i__ <= i__1; ++i__) { 00115 g[i__] = -g[i__]; 00116 x[i__] = center[i__] + g[i__] * hwidth[i__]; 00117 if (g[i__] < 0.) { 00118 goto L40; 00119 } 00120 /* L60: */ 00121 } 00122 00123 /* Find next distinct permutation of G and loop back for next sum. */ 00124 /* Permutations are generated in reverse lexicographic order. */ 00125 00126 i__1 = *ndim; 00127 for (i__ = 2; i__ <= i__1; ++i__) { 00128 if (g[i__ - 1] > g[i__]) { 00129 gi = g[i__]; 00130 ixchng = i__ - 1; 00131 i__2 = (i__ - 1) / 2; 00132 for (l = 1; l <= i__2; ++l) { 00133 gl = g[l]; 00134 g[l] = g[i__ - l]; 00135 g[i__ - l] = gl; 00136 if (gl <= gi) { 00137 --ixchng; 00138 } 00139 if (g[l] > gi) { 00140 lxchng = l; 00141 } 00142 /* L70: */ 00143 } 00144 if (g[ixchng] <= gi) { 00145 ixchng = lxchng; 00146 } 00147 g[i__] = g[ixchng]; 00148 g[ixchng] = gi; 00149 goto L20; 00150 } 00151 /* L80: */ 00152 } 00153 00154 /* Restore original order to generators */ 00155 00156 i__1 = *ndim / 2; 00157 for (i__ = 1; i__ <= i__1; ++i__) { 00158 gi = g[i__]; 00159 g[i__] = g[*ndim - i__ + 1]; 00160 g[*ndim - i__ + 1] = gi; 00161 /* L90: */ 00162 } 00163 00164 /* ***END DFSHRE */ 00165 00166 return 0; 00167 } /* dfshre_ */ 00168 00169 #ifdef __cplusplus 00170 } 00171 #endif