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