template_lapack_lasq6.h
Go to the documentation of this file.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 #ifndef TEMPLATE_LAPACK_LASQ6_HEADER
00036 #define TEMPLATE_LAPACK_LASQ6_HEADER
00037
00038 template<class Treal>
00039 int template_lapack_lasq6(integer *i0, integer *n0, Treal *z__,
00040 integer *pp, Treal *dmin__, Treal *dmin1, Treal *dmin2,
00041 Treal *dn, Treal *dnm1, Treal *dnm2)
00042 {
00043
00044 integer i__1;
00045 Treal d__1, d__2;
00046
00047
00048 Treal d__;
00049 integer j4, j4p2;
00050 Treal emin, temp;
00051 Treal safmin;
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
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 --z__;
00123
00124
00125 if (*n0 - *i0 - 1 <= 0) {
00126 return 0;
00127 }
00128
00129 safmin = template_lapack_lamch("Safe minimum", (Treal)0);
00130 j4 = (*i0 << 2) + *pp - 3;
00131 emin = z__[j4 + 4];
00132 d__ = z__[j4];
00133 *dmin__ = d__;
00134
00135 if (*pp == 0) {
00136 i__1 = (*n0 - 3) << 2;
00137 for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
00138 z__[j4 - 2] = d__ + z__[j4 - 1];
00139 if (z__[j4 - 2] == 0.) {
00140 z__[j4] = 0.;
00141 d__ = z__[j4 + 1];
00142 *dmin__ = d__;
00143 emin = 0.;
00144 } else if (safmin * z__[j4 + 1] < z__[j4 - 2] && safmin * z__[j4
00145 - 2] < z__[j4 + 1]) {
00146 temp = z__[j4 + 1] / z__[j4 - 2];
00147 z__[j4] = z__[j4 - 1] * temp;
00148 d__ *= temp;
00149 } else {
00150 z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]);
00151 d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]);
00152 }
00153 *dmin__ = minMACRO(*dmin__,d__);
00154
00155 d__1 = emin, d__2 = z__[j4];
00156 emin = minMACRO(d__1,d__2);
00157
00158 }
00159 } else {
00160 i__1 = ( *n0 - 3 ) << 2;
00161 for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
00162 z__[j4 - 3] = d__ + z__[j4];
00163 if (z__[j4 - 3] == 0.) {
00164 z__[j4 - 1] = 0.;
00165 d__ = z__[j4 + 2];
00166 *dmin__ = d__;
00167 emin = 0.;
00168 } else if (safmin * z__[j4 + 2] < z__[j4 - 3] && safmin * z__[j4
00169 - 3] < z__[j4 + 2]) {
00170 temp = z__[j4 + 2] / z__[j4 - 3];
00171 z__[j4 - 1] = z__[j4] * temp;
00172 d__ *= temp;
00173 } else {
00174 z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]);
00175 d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]);
00176 }
00177 *dmin__ = minMACRO(*dmin__,d__);
00178
00179 d__1 = emin, d__2 = z__[j4 - 1];
00180 emin = minMACRO(d__1,d__2);
00181
00182 }
00183 }
00184
00185
00186
00187 *dnm2 = d__;
00188 *dmin2 = *dmin__;
00189 j4 = ( ( *n0 - 2 ) << 2) - *pp;
00190 j4p2 = j4 + (*pp << 1) - 1;
00191 z__[j4 - 2] = *dnm2 + z__[j4p2];
00192 if (z__[j4 - 2] == 0.) {
00193 z__[j4] = 0.;
00194 *dnm1 = z__[j4p2 + 2];
00195 *dmin__ = *dnm1;
00196 emin = 0.;
00197 } else if (safmin * z__[j4p2 + 2] < z__[j4 - 2] && safmin * z__[j4 - 2] <
00198 z__[j4p2 + 2]) {
00199 temp = z__[j4p2 + 2] / z__[j4 - 2];
00200 z__[j4] = z__[j4p2] * temp;
00201 *dnm1 = *dnm2 * temp;
00202 } else {
00203 z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
00204 *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]);
00205 }
00206 *dmin__ = minMACRO(*dmin__,*dnm1);
00207
00208 *dmin1 = *dmin__;
00209 j4 += 4;
00210 j4p2 = j4 + (*pp << 1) - 1;
00211 z__[j4 - 2] = *dnm1 + z__[j4p2];
00212 if (z__[j4 - 2] == 0.) {
00213 z__[j4] = 0.;
00214 *dn = z__[j4p2 + 2];
00215 *dmin__ = *dn;
00216 emin = 0.;
00217 } else if (safmin * z__[j4p2 + 2] < z__[j4 - 2] && safmin * z__[j4 - 2] <
00218 z__[j4p2 + 2]) {
00219 temp = z__[j4p2 + 2] / z__[j4 - 2];
00220 z__[j4] = z__[j4p2] * temp;
00221 *dn = *dnm1 * temp;
00222 } else {
00223 z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
00224 *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]);
00225 }
00226 *dmin__ = minMACRO(*dmin__,*dn);
00227
00228 z__[j4 + 2] = *dn;
00229 z__[(*n0 << 2) - *pp] = emin;
00230 return 0;
00231
00232
00233
00234 }
00235
00236 #endif