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_GGBAK_HEADER
00038 #define TEMPLATE_LAPACK_GGBAK_HEADER
00039
00040
00041 template<class Treal>
00042 int template_lapack_ggbak(const char *job, const char *side, const integer *n, const integer *ilo,
00043 const integer *ihi, const Treal *lscale, const Treal *rscale, const integer *m,
00044 Treal *v, const integer *ldv, 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
00119
00120 integer v_dim1, v_offset, i__1;
00121
00122 integer i__, k;
00123 logical leftv;
00124 logical rightv;
00125 #define v_ref(a_1,a_2) v[(a_2)*v_dim1 + a_1]
00126
00127 --lscale;
00128 --rscale;
00129 v_dim1 = *ldv;
00130 v_offset = 1 + v_dim1 * 1;
00131 v -= v_offset;
00132
00133
00134 rightv = template_blas_lsame(side, "R");
00135 leftv = template_blas_lsame(side, "L");
00136
00137 *info = 0;
00138 if (! template_blas_lsame(job, "N") && ! template_blas_lsame(job, "P") && ! template_blas_lsame(job, "S")
00139 && ! template_blas_lsame(job, "B")) {
00140 *info = -1;
00141 } else if (! rightv && ! leftv) {
00142 *info = -2;
00143 } else if (*n < 0) {
00144 *info = -3;
00145 } else if (*ilo < 1) {
00146 *info = -4;
00147 } else if (*ihi < *ilo || *ihi > maxMACRO(1,*n)) {
00148 *info = -5;
00149 } else if (*m < 0) {
00150 *info = -6;
00151 } else if (*ldv < maxMACRO(1,*n)) {
00152 *info = -10;
00153 }
00154 if (*info != 0) {
00155 i__1 = -(*info);
00156 template_blas_erbla("GGBAK ", &i__1);
00157 return 0;
00158 }
00159
00160
00161
00162 if (*n == 0) {
00163 return 0;
00164 }
00165 if (*m == 0) {
00166 return 0;
00167 }
00168 if (template_blas_lsame(job, "N")) {
00169 return 0;
00170 }
00171
00172 if (*ilo == *ihi) {
00173 goto L30;
00174 }
00175
00176
00177
00178 if (template_blas_lsame(job, "S") || template_blas_lsame(job, "B")) {
00179
00180
00181
00182 if (rightv) {
00183 i__1 = *ihi;
00184 for (i__ = *ilo; i__ <= i__1; ++i__) {
00185 template_blas_scal(m, &rscale[i__], &v_ref(i__, 1), ldv);
00186
00187 }
00188 }
00189
00190
00191
00192 if (leftv) {
00193 i__1 = *ihi;
00194 for (i__ = *ilo; i__ <= i__1; ++i__) {
00195 template_blas_scal(m, &lscale[i__], &v_ref(i__, 1), ldv);
00196
00197 }
00198 }
00199 }
00200
00201
00202
00203 L30:
00204 if (template_blas_lsame(job, "P") || template_blas_lsame(job, "B")) {
00205
00206
00207
00208 if (rightv) {
00209 if (*ilo == 1) {
00210 goto L50;
00211 }
00212
00213 for (i__ = *ilo - 1; i__ >= 1; --i__) {
00214 k = (integer) rscale[i__];
00215 if (k == i__) {
00216 goto L40;
00217 }
00218 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
00219 L40:
00220 ;
00221 }
00222
00223 L50:
00224 if (*ihi == *n) {
00225 goto L70;
00226 }
00227 i__1 = *n;
00228 for (i__ = *ihi + 1; i__ <= i__1; ++i__) {
00229 k = (integer) rscale[i__];
00230 if (k == i__) {
00231 goto L60;
00232 }
00233 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
00234 L60:
00235 ;
00236 }
00237 }
00238
00239
00240
00241 L70:
00242 if (leftv) {
00243 if (*ilo == 1) {
00244 goto L90;
00245 }
00246 for (i__ = *ilo - 1; i__ >= 1; --i__) {
00247 k = (integer) lscale[i__];
00248 if (k == i__) {
00249 goto L80;
00250 }
00251 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
00252 L80:
00253 ;
00254 }
00255
00256 L90:
00257 if (*ihi == *n) {
00258 goto L110;
00259 }
00260 i__1 = *n;
00261 for (i__ = *ihi + 1; i__ <= i__1; ++i__) {
00262 k = (integer) lscale[i__];
00263 if (k == i__) {
00264 goto L100;
00265 }
00266 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
00267 L100:
00268 ;
00269 }
00270 }
00271 }
00272
00273 L110:
00274
00275 return 0;
00276
00277
00278
00279 }
00280
00281 #undef v_ref
00282
00283
00284 #endif