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_ORMQR_HEADER
00038 #define TEMPLATE_LAPACK_ORMQR_HEADER
00039
00040
00041 template<class Treal>
00042 int template_lapack_ormqr(char *side, char *trans, const integer *m, const integer *n,
00043 const integer *k, Treal *a, const integer *lda, const Treal *tau, Treal *
00044 c__, const integer *ldc, Treal *work, const integer *lwork, 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
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141 integer c__1 = 1;
00142 integer c_n1 = -1;
00143 integer c__2 = 2;
00144 integer c__65 = 65;
00145
00146
00147 address a__1[2];
00148 integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4,
00149 i__5;
00150 char ch__1[2];
00151
00152 logical left;
00153 integer i__;
00154 Treal t[4160] ;
00155 integer nbmin, iinfo, i1, i2, i3;
00156 integer ib, ic, jc, nb, mi, ni;
00157 integer nq, nw;
00158 logical notran;
00159 integer ldwork, lwkopt;
00160 logical lquery;
00161 integer iws;
00162 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
00163 #define c___ref(a_1,a_2) c__[(a_2)*c_dim1 + a_1]
00164
00165
00166 a_dim1 = *lda;
00167 a_offset = 1 + a_dim1 * 1;
00168 a -= a_offset;
00169 --tau;
00170 c_dim1 = *ldc;
00171 c_offset = 1 + c_dim1 * 1;
00172 c__ -= c_offset;
00173 --work;
00174
00175
00176 lwkopt = 0;
00177 nb = 0;
00178
00179 *info = 0;
00180 left = template_blas_lsame(side, "L");
00181 notran = template_blas_lsame(trans, "N");
00182 lquery = *lwork == -1;
00183
00184
00185
00186 if (left) {
00187 nq = *m;
00188 nw = *n;
00189 } else {
00190 nq = *n;
00191 nw = *m;
00192 }
00193 if (! left && ! template_blas_lsame(side, "R")) {
00194 *info = -1;
00195 } else if (! notran && ! template_blas_lsame(trans, "T")) {
00196 *info = -2;
00197 } else if (*m < 0) {
00198 *info = -3;
00199 } else if (*n < 0) {
00200 *info = -4;
00201 } else if (*k < 0 || *k > nq) {
00202 *info = -5;
00203 } else if (*lda < maxMACRO(1,nq)) {
00204 *info = -7;
00205 } else if (*ldc < maxMACRO(1,*m)) {
00206 *info = -10;
00207 } else if (*lwork < maxMACRO(1,nw) && ! lquery) {
00208 *info = -12;
00209 }
00210
00211 if (*info == 0) {
00212
00213
00214
00215
00216
00217
00218 i__3[0] = 1, a__1[0] = side;
00219 i__3[1] = 1, a__1[1] = trans;
00220 template_blas_s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
00221 i__1 = 64, i__2 = template_lapack_ilaenv(&c__1, "DORMQR", ch__1, m, n, k, &c_n1, (
00222 ftnlen)6, (ftnlen)2);
00223 nb = minMACRO(i__1,i__2);
00224 lwkopt = maxMACRO(1,nw) * nb;
00225 work[1] = (Treal) lwkopt;
00226 }
00227
00228 if (*info != 0) {
00229 i__1 = -(*info);
00230 template_blas_erbla("ORMQR ", &i__1);
00231 return 0;
00232 } else if (lquery) {
00233 return 0;
00234 }
00235
00236
00237
00238 if (*m == 0 || *n == 0 || *k == 0) {
00239 work[1] = 1.;
00240 return 0;
00241 }
00242
00243 nbmin = 2;
00244 ldwork = nw;
00245 if (nb > 1 && nb < *k) {
00246 iws = nw * nb;
00247 if (*lwork < iws) {
00248 nb = *lwork / ldwork;
00249
00250
00251 i__3[0] = 1, a__1[0] = side;
00252 i__3[1] = 1, a__1[1] = trans;
00253 template_blas_s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
00254 i__1 = 2, i__2 = template_lapack_ilaenv(&c__2, "DORMQR", ch__1, m, n, k, &c_n1, (
00255 ftnlen)6, (ftnlen)2);
00256 nbmin = maxMACRO(i__1,i__2);
00257 }
00258 } else {
00259 iws = nw;
00260 }
00261
00262 if (nb < nbmin || nb >= *k) {
00263
00264
00265
00266 template_lapack_orm2r(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
00267 c_offset], ldc, &work[1], &iinfo);
00268 } else {
00269
00270
00271
00272 if ( ( left && ! notran ) || ( ! left && notran ) ) {
00273 i1 = 1;
00274 i2 = *k;
00275 i3 = nb;
00276 } else {
00277 i1 = (*k - 1) / nb * nb + 1;
00278 i2 = 1;
00279 i3 = -nb;
00280 }
00281
00282 if (left) {
00283 ni = *n;
00284 jc = 1;
00285 } else {
00286 mi = *m;
00287 ic = 1;
00288 }
00289
00290 i__1 = i2;
00291 i__2 = i3;
00292 for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
00293
00294 i__4 = nb, i__5 = *k - i__ + 1;
00295 ib = minMACRO(i__4,i__5);
00296
00297
00298
00299
00300 i__4 = nq - i__ + 1;
00301 template_lapack_larft("Forward", "Columnwise", &i__4, &ib, &a_ref(i__, i__),
00302 lda, &tau[i__], t, &c__65);
00303 if (left) {
00304
00305
00306
00307 mi = *m - i__ + 1;
00308 ic = i__;
00309 } else {
00310
00311
00312
00313 ni = *n - i__ + 1;
00314 jc = i__;
00315 }
00316
00317
00318
00319 template_lapack_larfb(side, trans, "Forward", "Columnwise", &mi, &ni, &ib, &
00320 a_ref(i__, i__), lda, t, &c__65, &c___ref(ic, jc), ldc, &
00321 work[1], &ldwork);
00322
00323 }
00324 }
00325 work[1] = (Treal) lwkopt;
00326 return 0;
00327
00328
00329
00330 }
00331
00332 #undef c___ref
00333 #undef a_ref
00334
00335
00336 #endif