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