1 #include "gmx_lapack.h"
2 #include "lapack_limits.h"
6 F77_FUNC(sorgqr,SORGQR)(int *m,
16 int a_dim1, a_offset, i__1, i__2, i__3;
18 int i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
23 a_offset = 1 + a_dim1;
30 nb = DORGQR_BLOCKSIZE;
32 work[1] = (float) lwkopt;
33 lquery = *lwork == -1;
36 } else if (*n < 0 || *n > *m) {
38 } else if (*k < 0 || *k > *n) {
40 } else if (*lda < (*m)) {
42 } else if (*lwork < (*n) && ! lquery) {
60 if (nb > 1 && nb < *k) {
62 nx = DORGQR_CROSSOVER;
70 nbmin = DORGQR_MINBLOCKSIZE;
75 if (nb >= nbmin && nb < *k && nx < *k) {
77 ki = (*k - nx - 1) / nb * nb;
78 i__1 = *k, i__2 = ki + nb;
79 kk = (i__1<i__2) ? i__1 : i__2;
82 for (j = kk + 1; j <= i__1; ++j) {
84 for (i__ = 1; i__ <= i__2; ++i__) {
85 a[i__ + j * a_dim1] = 0.;
96 F77_FUNC(sorg2r,SORG2R)(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &
97 tau[kk + 1], &work[1], &iinfo);
103 for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
104 i__2 = nb, i__3 = *k - i__ + 1;
105 ib = (i__2<i__3) ? i__2 : i__3;
106 if (i__ + ib <= *n) {
109 F77_FUNC(slarft,SLARFT)("Forward", "Columnwise", &i__2, &ib, &a[i__ + i__ *
110 a_dim1], lda, &tau[i__], &work[1], &ldwork);
113 i__3 = *n - i__ - ib + 1;
114 F77_FUNC(slarfb,SLARFB)("Left", "No transpose", "Forward", "Columnwise", &
115 i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[
116 1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &
117 work[ib + 1], &ldwork);
121 F77_FUNC(sorg2r,SORG2R)(&i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &
125 for (j = i__; j <= i__2; ++j) {
127 for (l = 1; l <= i__3; ++l) {
128 a[l + j * a_dim1] = 0.;
134 work[1] = (float) iws;