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