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_ORGQL_HEADER
00038 #define TEMPLATE_LAPACK_ORGQL_HEADER
00039
00040
00041 template<class Treal>
00042 int template_lapack_orgql(const integer *m, const integer *n, const integer *k, Treal *
00043 a, const integer *lda, const Treal *tau, Treal *work, const integer *lwork,
00044 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 integer c__1 = 1;
00115 integer c_n1 = -1;
00116 integer c__3 = 3;
00117 integer c__2 = 2;
00118
00119
00120 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
00121
00122 integer i__, j, l, nbmin, iinfo;
00123 integer ib, nb, kk;
00124 integer nx;
00125 integer ldwork, lwkopt;
00126 logical lquery;
00127 integer iws;
00128 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
00129
00130
00131 a_dim1 = *lda;
00132 a_offset = 1 + a_dim1 * 1;
00133 a -= a_offset;
00134 --tau;
00135 --work;
00136
00137
00138 *info = 0;
00139 nb = template_lapack_ilaenv(&c__1, "DORGQL", " ", m, n, k, &c_n1, (ftnlen)6, (ftnlen)1);
00140 lwkopt = maxMACRO(1,*n) * nb;
00141 work[1] = (Treal) lwkopt;
00142 lquery = *lwork == -1;
00143 if (*m < 0) {
00144 *info = -1;
00145 } else if (*n < 0 || *n > *m) {
00146 *info = -2;
00147 } else if (*k < 0 || *k > *n) {
00148 *info = -3;
00149 } else if (*lda < maxMACRO(1,*m)) {
00150 *info = -5;
00151 } else if (*lwork < maxMACRO(1,*n) && ! lquery) {
00152 *info = -8;
00153 }
00154 if (*info != 0) {
00155 i__1 = -(*info);
00156 template_blas_erbla("ORGQL ", &i__1);
00157 return 0;
00158 } else if (lquery) {
00159 return 0;
00160 }
00161
00162
00163
00164 if (*n <= 0) {
00165 work[1] = 1.;
00166 return 0;
00167 }
00168
00169 nbmin = 2;
00170 nx = 0;
00171 iws = *n;
00172 if (nb > 1 && nb < *k) {
00173
00174
00175
00176
00177 i__1 = 0, i__2 = template_lapack_ilaenv(&c__3, "DORGQL", " ", m, n, k, &c_n1, (
00178 ftnlen)6, (ftnlen)1);
00179 nx = maxMACRO(i__1,i__2);
00180 if (nx < *k) {
00181
00182
00183
00184 ldwork = *n;
00185 iws = ldwork * nb;
00186 if (*lwork < iws) {
00187
00188
00189
00190
00191 nb = *lwork / ldwork;
00192
00193 i__1 = 2, i__2 = template_lapack_ilaenv(&c__2, "DORGQL", " ", m, n, k, &c_n1,
00194 (ftnlen)6, (ftnlen)1);
00195 nbmin = maxMACRO(i__1,i__2);
00196 }
00197 }
00198 }
00199
00200 if (nb >= nbmin && nb < *k && nx < *k) {
00201
00202
00203
00204
00205
00206 i__1 = *k, i__2 = (*k - nx + nb - 1) / nb * nb;
00207 kk = minMACRO(i__1,i__2);
00208
00209
00210
00211 i__1 = *n - kk;
00212 for (j = 1; j <= i__1; ++j) {
00213 i__2 = *m;
00214 for (i__ = *m - kk + 1; i__ <= i__2; ++i__) {
00215 a_ref(i__, j) = 0.;
00216
00217 }
00218
00219 }
00220 } else {
00221 kk = 0;
00222 }
00223
00224
00225
00226 i__1 = *m - kk;
00227 i__2 = *n - kk;
00228 i__3 = *k - kk;
00229 template_lapack_org2l(&i__1, &i__2, &i__3, &a[a_offset], lda, &tau[1], &work[1], &iinfo)
00230 ;
00231
00232 if (kk > 0) {
00233
00234
00235
00236 i__1 = *k;
00237 i__2 = nb;
00238 for (i__ = *k - kk + 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ +=
00239 i__2) {
00240
00241 i__3 = nb, i__4 = *k - i__ + 1;
00242 ib = minMACRO(i__3,i__4);
00243 if (*n - *k + i__ > 1) {
00244
00245
00246
00247
00248 i__3 = *m - *k + i__ + ib - 1;
00249 template_lapack_larft("Backward", "Columnwise", &i__3, &ib, &a_ref(1, *n - *
00250 k + i__), lda, &tau[i__], &work[1], &ldwork);
00251
00252
00253
00254 i__3 = *m - *k + i__ + ib - 1;
00255 i__4 = *n - *k + i__ - 1;
00256 template_lapack_larfb("Left", "No transpose", "Backward", "Columnwise", &
00257 i__3, &i__4, &ib, &a_ref(1, *n - *k + i__), lda, &
00258 work[1], &ldwork, &a[a_offset], lda, &work[ib + 1], &
00259 ldwork);
00260 }
00261
00262
00263
00264 i__3 = *m - *k + i__ + ib - 1;
00265 template_lapack_org2l(&i__3, &ib, &ib, &a_ref(1, *n - *k + i__), lda, &tau[i__],
00266 &work[1], &iinfo);
00267
00268
00269
00270 i__3 = *n - *k + i__ + ib - 1;
00271 for (j = *n - *k + i__; j <= i__3; ++j) {
00272 i__4 = *m;
00273 for (l = *m - *k + i__ + ib; l <= i__4; ++l) {
00274 a_ref(l, j) = 0.;
00275
00276 }
00277
00278 }
00279
00280 }
00281 }
00282
00283 work[1] = (Treal) iws;
00284 return 0;
00285
00286
00287
00288 }
00289
00290 #undef a_ref
00291
00292
00293 #endif