1 #include "gmx_lapack.h"
4 F77_FUNC(dlasd0,DLASD0)(int *n,
17 int u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
19 int i__, j, m, i1, ic, lf, nd, ll, nl, nr, im1, ncc, nlf, nrf,
20 iwk, lvl, ndb1, nlp1, nrp1;
24 int inode, ndiml, idxqc, ndimr, itemp, sqrei;
31 u_offset = 1 + u_dim1;
34 vt_offset = 1 + vt_dim1;
43 } else if (*sqre < 0 || *sqre > 1) {
51 } else if (*ldvt < m) {
53 } else if (*smlsiz < 3) {
62 F77_FUNC(dlasdq,DLASDQ)("U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset],
63 ldvt, &u[u_offset], ldu, &u[u_offset], ldu, &work[1], info);
72 F77_FUNC(dlasdt,DLASDT)(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
78 for (i__ = ndb1; i__ <= i__1; ++i__) {
81 ic = iwork[inode + i1];
82 nl = iwork[ndiml + i1];
84 nr = iwork[ndimr + i1];
89 F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &vt[
90 nlf + nlf * vt_dim1], ldvt, &u[nlf + nlf * u_dim1], ldu, &u[
91 nlf + nlf * u_dim1], ldu, &work[1], info);
95 itemp = idxq + nlf - 2;
97 for (j = 1; j <= i__2; ++j) {
106 F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &vt[
107 nrf + nrf * vt_dim1], ldvt, &u[nrf + nrf * u_dim1], ldu, &u[
108 nrf + nrf * u_dim1], ldu, &work[1], info);
114 for (j = 1; j <= i__2; ++j) {
115 iwork[itemp + j - 1] = j;
119 for (lvl = nlvl; lvl >= 1; --lvl) {
130 for (i__ = lf; i__ <= i__1; ++i__) {
132 ic = iwork[inode + im1];
133 nl = iwork[ndiml + im1];
134 nr = iwork[ndimr + im1];
136 if (*sqre == 0 && i__ == ll) {
141 idxqc = idxq + nlf - 1;
144 F77_FUNC(dlasd1,DLASD1)(&nl, &nr, &sqrei, &d__[nlf], &alpha, &beta, &u[nlf + nlf *
145 u_dim1], ldu, &vt[nlf + nlf * vt_dim1], ldvt, &iwork[
146 idxqc], &iwork[iwk], &work[1], info);