00001
00002
00003
00004
00005
00006 #ifdef __cplusplus
00007 extern "C" {
00008 #endif
00009 #include "f2c.h"
00010
00011 int dtrhre_(integer *dvflag, integer *ndim, integer *numfun,
00012 integer *sbrgns, doublereal *values, doublereal *errors, doublereal *
00013 centrs, doublereal *hwidts, doublereal *greate, doublereal *error,
00014 doublereal *value, doublereal *center, doublereal *hwidth, doublereal
00015 *dir)
00016 {
00017
00018 integer values_dim1, values_offset, errors_dim1, errors_offset,
00019 centrs_dim1, centrs_offset, hwidts_dim1, hwidts_offset, i__1;
00020
00021
00022 static integer j;
00023 static doublereal great, direct;
00024 static integer subrgn, subtmp;
00025
00026
00027
00028
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
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092 --hwidth;
00093 --center;
00094 hwidts_dim1 = *ndim;
00095 hwidts_offset = 1 + hwidts_dim1;
00096 hwidts -= hwidts_offset;
00097 centrs_dim1 = *ndim;
00098 centrs_offset = 1 + centrs_dim1;
00099 centrs -= centrs_offset;
00100 --value;
00101 --error;
00102 errors_dim1 = *numfun;
00103 errors_offset = 1 + errors_dim1;
00104 errors -= errors_offset;
00105 values_dim1 = *numfun;
00106 values_offset = 1 + values_dim1;
00107 values -= values_offset;
00108 --greate;
00109 --dir;
00110
00111
00112 great = greate[*sbrgns];
00113 direct = dir[*sbrgns];
00114 i__1 = *numfun;
00115 for (j = 1; j <= i__1; ++j) {
00116 error[j] = errors[j + *sbrgns * errors_dim1];
00117 value[j] = values[j + *sbrgns * values_dim1];
00118
00119 }
00120 i__1 = *ndim;
00121 for (j = 1; j <= i__1; ++j) {
00122 center[j] = centrs[j + *sbrgns * centrs_dim1];
00123 hwidth[j] = hwidts[j + *sbrgns * hwidts_dim1];
00124
00125 }
00126
00127
00128
00129
00130 if (*dvflag == 1) {
00131 --(*sbrgns);
00132 subrgn = 1;
00133 L20:
00134 subtmp = subrgn << 1;
00135 if (subtmp <= *sbrgns) {
00136 if (subtmp != *sbrgns) {
00137
00138
00139
00140 if (greate[subtmp] < greate[subtmp + 1]) {
00141 ++subtmp;
00142 }
00143 }
00144
00145
00146
00147
00148 if (great < greate[subtmp]) {
00149
00150
00151
00152 greate[subrgn] = greate[subtmp];
00153 i__1 = *numfun;
00154 for (j = 1; j <= i__1; ++j) {
00155 errors[j + subrgn * errors_dim1] = errors[j + subtmp *
00156 errors_dim1];
00157 values[j + subrgn * values_dim1] = values[j + subtmp *
00158 values_dim1];
00159
00160 }
00161 dir[subrgn] = dir[subtmp];
00162 i__1 = *ndim;
00163 for (j = 1; j <= i__1; ++j) {
00164 centrs[j + subrgn * centrs_dim1] = centrs[j + subtmp *
00165 centrs_dim1];
00166 hwidts[j + subrgn * hwidts_dim1] = hwidts[j + subtmp *
00167 hwidts_dim1];
00168
00169 }
00170 subrgn = subtmp;
00171 goto L20;
00172 }
00173 }
00174 } else if (*dvflag == 2) {
00175
00176
00177
00178 subrgn = *sbrgns;
00179 L40:
00180 subtmp = subrgn / 2;
00181 if (subtmp >= 1) {
00182
00183
00184
00185
00186 if (great > greate[subtmp]) {
00187
00188
00189
00190 greate[subrgn] = greate[subtmp];
00191 i__1 = *numfun;
00192 for (j = 1; j <= i__1; ++j) {
00193 errors[j + subrgn * errors_dim1] = errors[j + subtmp *
00194 errors_dim1];
00195 values[j + subrgn * values_dim1] = values[j + subtmp *
00196 values_dim1];
00197
00198 }
00199 dir[subrgn] = dir[subtmp];
00200 i__1 = *ndim;
00201 for (j = 1; j <= i__1; ++j) {
00202 centrs[j + subrgn * centrs_dim1] = centrs[j + subtmp *
00203 centrs_dim1];
00204 hwidts[j + subrgn * hwidts_dim1] = hwidts[j + subtmp *
00205 hwidts_dim1];
00206
00207 }
00208 subrgn = subtmp;
00209 goto L40;
00210 }
00211 }
00212 }
00213
00214
00215
00216 if (*sbrgns > 0) {
00217 greate[subrgn] = great;
00218 i__1 = *numfun;
00219 for (j = 1; j <= i__1; ++j) {
00220 errors[j + subrgn * errors_dim1] = error[j];
00221 values[j + subrgn * values_dim1] = value[j];
00222
00223 }
00224 dir[subrgn] = direct;
00225 i__1 = *ndim;
00226 for (j = 1; j <= i__1; ++j) {
00227 centrs[j + subrgn * centrs_dim1] = center[j];
00228 hwidts[j + subrgn * hwidts_dim1] = hwidth[j];
00229
00230 }
00231 }
00232
00233
00234
00235 return 0;
00236 }
00237
00238 #ifdef __cplusplus
00239 }
00240 #endif