00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037 #ifndef TEMPLATE_LAPACK_LASQ5_HEADER
00038 #define TEMPLATE_LAPACK_LASQ5_HEADER
00039
00040 template<class Treal>
00041 int template_lapack_lasq5(integer *i0, integer *n0, Treal *z__,
00042 integer *pp, Treal *tau, Treal *dmin__, Treal *dmin1,
00043 Treal *dmin2, Treal *dn, Treal *dnm1, Treal *dnm2,
00044 logical *ieee)
00045 {
00046
00047 integer i__1;
00048 Treal d__1, d__2;
00049
00050
00051 Treal d__;
00052 integer j4, j4p2;
00053 Treal emin, temp;
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
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128 --z__;
00129
00130
00131 if (*n0 - *i0 - 1 <= 0) {
00132 return 0;
00133 }
00134
00135 j4 = (*i0 << 2) + *pp - 3;
00136 emin = z__[j4 + 4];
00137 d__ = z__[j4] - *tau;
00138 *dmin__ = d__;
00139 *dmin1 = -z__[j4];
00140
00141 if (*ieee) {
00142
00143
00144
00145 if (*pp == 0) {
00146 i__1 = ( *n0 - 3 ) << 2;
00147 for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
00148 z__[j4 - 2] = d__ + z__[j4 - 1];
00149 temp = z__[j4 + 1] / z__[j4 - 2];
00150 d__ = d__ * temp - *tau;
00151 *dmin__ = minMACRO(*dmin__,d__);
00152 z__[j4] = z__[j4 - 1] * temp;
00153
00154 d__1 = z__[j4];
00155 emin = minMACRO(d__1,emin);
00156
00157 }
00158 } else {
00159 i__1 = ( *n0 - 3 ) << 2;
00160 for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
00161 z__[j4 - 3] = d__ + z__[j4];
00162 temp = z__[j4 + 2] / z__[j4 - 3];
00163 d__ = d__ * temp - *tau;
00164 *dmin__ = minMACRO(*dmin__,d__);
00165 z__[j4 - 1] = z__[j4] * temp;
00166
00167 d__1 = z__[j4 - 1];
00168 emin = minMACRO(d__1,emin);
00169
00170 }
00171 }
00172
00173
00174
00175 *dnm2 = d__;
00176 *dmin2 = *dmin__;
00177 j4 = ( ( *n0 - 2 ) << 2) - *pp;
00178 j4p2 = j4 + (*pp << 1) - 1;
00179 z__[j4 - 2] = *dnm2 + z__[j4p2];
00180 z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
00181 *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau;
00182 *dmin__ = minMACRO(*dmin__,*dnm1);
00183
00184 *dmin1 = *dmin__;
00185 j4 += 4;
00186 j4p2 = j4 + (*pp << 1) - 1;
00187 z__[j4 - 2] = *dnm1 + z__[j4p2];
00188 z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
00189 *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau;
00190 *dmin__ = minMACRO(*dmin__,*dn);
00191
00192 } else {
00193
00194
00195
00196 if (*pp == 0) {
00197 i__1 = ( *n0 - 3 ) << 2;
00198 for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
00199 z__[j4 - 2] = d__ + z__[j4 - 1];
00200 if (d__ < 0.) {
00201 return 0;
00202 } else {
00203 z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]);
00204 d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]) - *tau;
00205 }
00206 *dmin__ = minMACRO(*dmin__,d__);
00207
00208 d__1 = emin, d__2 = z__[j4];
00209 emin = minMACRO(d__1,d__2);
00210
00211 }
00212 } else {
00213 i__1 = ( *n0 - 3 ) << 2;
00214 for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
00215 z__[j4 - 3] = d__ + z__[j4];
00216 if (d__ < 0.) {
00217 return 0;
00218 } else {
00219 z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]);
00220 d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]) - *tau;
00221 }
00222 *dmin__ = minMACRO(*dmin__,d__);
00223
00224 d__1 = emin, d__2 = z__[j4 - 1];
00225 emin = minMACRO(d__1,d__2);
00226
00227 }
00228 }
00229
00230
00231
00232 *dnm2 = d__;
00233 *dmin2 = *dmin__;
00234 j4 = ( ( *n0 - 2 ) << 2) - *pp;
00235 j4p2 = j4 + (*pp << 1) - 1;
00236 z__[j4 - 2] = *dnm2 + z__[j4p2];
00237 if (*dnm2 < 0.) {
00238 return 0;
00239 } else {
00240 z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
00241 *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau;
00242 }
00243 *dmin__ = minMACRO(*dmin__,*dnm1);
00244
00245 *dmin1 = *dmin__;
00246 j4 += 4;
00247 j4p2 = j4 + (*pp << 1) - 1;
00248 z__[j4 - 2] = *dnm1 + z__[j4p2];
00249 if (*dnm1 < 0.) {
00250 return 0;
00251 } else {
00252 z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
00253 *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau;
00254 }
00255 *dmin__ = minMACRO(*dmin__,*dn);
00256
00257 }
00258
00259 z__[j4 + 2] = *dn;
00260 z__[(*n0 << 2) - *pp] = emin;
00261 return 0;
00262
00263
00264
00265 }
00266
00267 #endif