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_LASCL_HEADER
00036 #define TEMPLATE_LAPACK_LASCL_HEADER
00037
00038
00039 template<class Treal>
00040 int template_lapack_lascl(const char *type__, const integer *kl, const integer *ku,
00041 const Treal *cfrom, const Treal *cto, const integer *m, const integer *n,
00042 Treal *a, const integer *lda, integer *info)
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
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116 integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
00117
00118 logical done;
00119 Treal ctoc;
00120 integer i__, j;
00121 integer itype, k1, k2, k3, k4;
00122 Treal cfrom1;
00123 Treal cfromc;
00124 Treal bignum, smlnum, mul, cto1;
00125 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
00126
00127 a_dim1 = *lda;
00128 a_offset = 1 + a_dim1 * 1;
00129 a -= a_offset;
00130
00131
00132 *info = 0;
00133
00134 if (template_blas_lsame(type__, "G")) {
00135 itype = 0;
00136 } else if (template_blas_lsame(type__, "L")) {
00137 itype = 1;
00138 } else if (template_blas_lsame(type__, "U")) {
00139 itype = 2;
00140 } else if (template_blas_lsame(type__, "H")) {
00141 itype = 3;
00142 } else if (template_blas_lsame(type__, "B")) {
00143 itype = 4;
00144 } else if (template_blas_lsame(type__, "Q")) {
00145 itype = 5;
00146 } else if (template_blas_lsame(type__, "Z")) {
00147 itype = 6;
00148 } else {
00149 itype = -1;
00150 }
00151
00152 if (itype == -1) {
00153 *info = -1;
00154 } else if (*cfrom == 0.) {
00155 *info = -4;
00156 } else if (*m < 0) {
00157 *info = -6;
00158 } else if (*n < 0 || ( itype == 4 && *n != *m ) || ( itype == 5 && *n != *m ) ) {
00159 *info = -7;
00160 } else if (itype <= 3 && *lda < maxMACRO(1,*m)) {
00161 *info = -9;
00162 } else if (itype >= 4) {
00163
00164 i__1 = *m - 1;
00165 if (*kl < 0 || *kl > maxMACRO(i__1,0)) {
00166 *info = -2;
00167 } else {
00168
00169 i__1 = *n - 1;
00170 if (*ku < 0 || *ku > maxMACRO(i__1,0) || ( (itype == 4 || itype == 5) &&
00171 *kl != *ku ) ) {
00172 *info = -3;
00173 } else if ( ( itype == 4 && *lda < *kl + 1 ) || ( itype == 5 && *lda < *
00174 ku + 1 ) || ( itype == 6 && *lda < (*kl << 1) + *ku + 1 ) ) {
00175 *info = -9;
00176 }
00177 }
00178 }
00179
00180 if (*info != 0) {
00181 i__1 = -(*info);
00182 template_blas_erbla("LASCL ", &i__1);
00183 return 0;
00184 }
00185
00186
00187
00188 if (*n == 0 || *m == 0) {
00189 return 0;
00190 }
00191
00192
00193
00194 smlnum = template_lapack_lamch("S", (Treal)0);
00195 bignum = 1. / smlnum;
00196
00197 cfromc = *cfrom;
00198 ctoc = *cto;
00199
00200 L10:
00201 cfrom1 = cfromc * smlnum;
00202 cto1 = ctoc / bignum;
00203 if (absMACRO(cfrom1) > absMACRO(ctoc) && ctoc != 0.) {
00204 mul = smlnum;
00205 done = FALSE_;
00206 cfromc = cfrom1;
00207 } else if (absMACRO(cto1) > absMACRO(cfromc)) {
00208 mul = bignum;
00209 done = FALSE_;
00210 ctoc = cto1;
00211 } else {
00212 mul = ctoc / cfromc;
00213 done = TRUE_;
00214 }
00215
00216 if (itype == 0) {
00217
00218
00219
00220 i__1 = *n;
00221 for (j = 1; j <= i__1; ++j) {
00222 i__2 = *m;
00223 for (i__ = 1; i__ <= i__2; ++i__) {
00224 a_ref(i__, j) = a_ref(i__, j) * mul;
00225
00226 }
00227
00228 }
00229
00230 } else if (itype == 1) {
00231
00232
00233
00234 i__1 = *n;
00235 for (j = 1; j <= i__1; ++j) {
00236 i__2 = *m;
00237 for (i__ = j; i__ <= i__2; ++i__) {
00238 a_ref(i__, j) = a_ref(i__, j) * mul;
00239
00240 }
00241
00242 }
00243
00244 } else if (itype == 2) {
00245
00246
00247
00248 i__1 = *n;
00249 for (j = 1; j <= i__1; ++j) {
00250 i__2 = minMACRO(j,*m);
00251 for (i__ = 1; i__ <= i__2; ++i__) {
00252 a_ref(i__, j) = a_ref(i__, j) * mul;
00253
00254 }
00255
00256 }
00257
00258 } else if (itype == 3) {
00259
00260
00261
00262 i__1 = *n;
00263 for (j = 1; j <= i__1; ++j) {
00264
00265 i__3 = j + 1;
00266 i__2 = minMACRO(i__3,*m);
00267 for (i__ = 1; i__ <= i__2; ++i__) {
00268 a_ref(i__, j) = a_ref(i__, j) * mul;
00269
00270 }
00271
00272 }
00273
00274 } else if (itype == 4) {
00275
00276
00277
00278 k3 = *kl + 1;
00279 k4 = *n + 1;
00280 i__1 = *n;
00281 for (j = 1; j <= i__1; ++j) {
00282
00283 i__3 = k3, i__4 = k4 - j;
00284 i__2 = minMACRO(i__3,i__4);
00285 for (i__ = 1; i__ <= i__2; ++i__) {
00286 a_ref(i__, j) = a_ref(i__, j) * mul;
00287
00288 }
00289
00290 }
00291
00292 } else if (itype == 5) {
00293
00294
00295
00296 k1 = *ku + 2;
00297 k3 = *ku + 1;
00298 i__1 = *n;
00299 for (j = 1; j <= i__1; ++j) {
00300
00301 i__2 = k1 - j;
00302 i__3 = k3;
00303 for (i__ = maxMACRO(i__2,1); i__ <= i__3; ++i__) {
00304 a_ref(i__, j) = a_ref(i__, j) * mul;
00305
00306 }
00307
00308 }
00309
00310 } else if (itype == 6) {
00311
00312
00313
00314 k1 = *kl + *ku + 2;
00315 k2 = *kl + 1;
00316 k3 = (*kl << 1) + *ku + 1;
00317 k4 = *kl + *ku + 1 + *m;
00318 i__1 = *n;
00319 for (j = 1; j <= i__1; ++j) {
00320
00321 i__3 = k1 - j;
00322
00323 i__4 = k3, i__5 = k4 - j;
00324 i__2 = minMACRO(i__4,i__5);
00325 for (i__ = maxMACRO(i__3,k2); i__ <= i__2; ++i__) {
00326 a_ref(i__, j) = a_ref(i__, j) * mul;
00327
00328 }
00329
00330 }
00331
00332 }
00333
00334 if (! done) {
00335 goto L10;
00336 }
00337
00338 return 0;
00339
00340
00341
00342 }
00343
00344 #undef a_ref
00345
00346
00347 #endif