2 #include "gmx_lapack.h"
5 F77_FUNC(slasda,SLASDA)(int *icompq,
30 int givcol_dim1, givcol_offset, perm_dim1, perm_offset, difl_dim1,
31 difl_offset, difr_dim1, difr_offset, givnum_dim1, givnum_offset,
32 poles_dim1, poles_offset, u_dim1, u_offset, vt_dim1, vt_offset,
33 z_dim1, z_offset, i__1, i__2;
35 int i__, j, m, i1, ic, lf, nd, ll, nl, vf, nr, vl, im1, ncc,
36 nlf, nrf, vfi, iwk, vli, lvl, nru, ndb1, nlp1, lvl2, nrp1;
40 int inode, ndiml, ndimr, idxqi, itemp;
51 givnum_offset = 1 + givnum_dim1;
52 givnum -= givnum_offset;
54 poles_offset = 1 + poles_dim1;
55 poles -= poles_offset;
57 z_offset = 1 + z_dim1;
60 difr_offset = 1 + difr_dim1;
63 difl_offset = 1 + difl_dim1;
66 vt_offset = 1 + vt_dim1;
69 u_offset = 1 + u_dim1;
74 perm_offset = 1 + perm_dim1;
76 givcol_dim1 = *ldgcol;
77 givcol_offset = 1 + givcol_dim1;
78 givcol -= givcol_offset;
89 F77_FUNC(slasdq,SLASDQ)("U", sqre, n, &c__0, &c__0, &c__0, &d__[1], &e[1], &vt[
90 vt_offset], ldu, &u[u_offset], ldu, &u[u_offset], ldu, &
93 F77_FUNC(slasdq,SLASDQ)("U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset]
94 , ldu, &u[u_offset], ldu, &u[u_offset], ldu, &work[1],
109 smlszp = *smlsiz + 1;
113 nwork2 = nwork1 + smlszp * smlszp;
115 F77_FUNC(slasdt,SLASDT)(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
120 for (i__ = ndb1; i__ <= i__1; ++i__) {
122 ic = iwork[inode + i1];
123 nl = iwork[ndiml + i1];
125 nr = iwork[ndimr + i1];
128 idxqi = idxq + nlf - 2;
133 F77_FUNC(slaset,SLASET)("A", &nlp1, &nlp1, &zero, &one, &work[nwork1], &smlszp);
134 F77_FUNC(slasdq,SLASDQ)("U", &sqrei, &nl, &nlp1, &nru, &ncc, &d__[nlf], &e[nlf], &
135 work[nwork1], &smlszp, &work[nwork2], &nl, &work[nwork2],
136 &nl, &work[nwork2], info);
137 itemp = nwork1 + nl * smlszp;
138 F77_FUNC(scopy,SCOPY)(&nlp1, &work[nwork1], &c__1, &work[vfi], &c__1);
139 F77_FUNC(scopy,SCOPY)(&nlp1, &work[itemp], &c__1, &work[vli], &c__1);
141 F77_FUNC(slaset,SLASET)("A", &nl, &nl, &zero, &one, &u[nlf + u_dim1], ldu);
142 F77_FUNC(slaset,SLASET)("A", &nlp1, &nlp1, &zero, &one, &vt[nlf + vt_dim1],
144 F77_FUNC(slasdq,SLASDQ)("U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &
145 vt[nlf + vt_dim1], ldu, &u[nlf + u_dim1], ldu, &u[nlf +
146 u_dim1], ldu, &work[nwork1], info);
147 F77_FUNC(scopy,SCOPY)(&nlp1, &vt[nlf + vt_dim1], &c__1, &work[vfi], &c__1);
148 F77_FUNC(scopy,SCOPY)(&nlp1, &vt[nlf + nlp1 * vt_dim1], &c__1, &work[vli], &c__1)
155 for (j = 1; j <= i__2; ++j) {
156 iwork[idxqi + j] = j;
158 if (i__ == nd && *sqre == 0) {
168 F77_FUNC(slaset,SLASET)("A", &nrp1, &nrp1, &zero, &one, &work[nwork1], &smlszp);
169 F77_FUNC(slasdq,SLASDQ)("U", &sqrei, &nr, &nrp1, &nru, &ncc, &d__[nrf], &e[nrf], &
170 work[nwork1], &smlszp, &work[nwork2], &nr, &work[nwork2],
171 &nr, &work[nwork2], info);
172 itemp = nwork1 + (nrp1 - 1) * smlszp;
173 F77_FUNC(scopy,SCOPY)(&nrp1, &work[nwork1], &c__1, &work[vfi], &c__1);
174 F77_FUNC(scopy,SCOPY)(&nrp1, &work[itemp], &c__1, &work[vli], &c__1);
176 F77_FUNC(slaset,SLASET)("A", &nr, &nr, &zero, &one, &u[nrf + u_dim1], ldu);
177 F77_FUNC(slaset,SLASET)("A", &nrp1, &nrp1, &zero, &one, &vt[nrf + vt_dim1],
179 F77_FUNC(slasdq,SLASDQ)("U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &
180 vt[nrf + vt_dim1], ldu, &u[nrf + u_dim1], ldu, &u[nrf +
181 u_dim1], ldu, &work[nwork1], info);
182 F77_FUNC(scopy,SCOPY)(&nrp1, &vt[nrf + vt_dim1], &c__1, &work[vfi], &c__1);
183 F77_FUNC(scopy,SCOPY)(&nrp1, &vt[nrf + nrp1 * vt_dim1], &c__1, &work[vli], &c__1)
190 for (j = 1; j <= i__2; ++j) {
191 iwork[idxqi + j] = j;
197 for (lvl = nlvl; lvl >= 1; --lvl) {
198 lvl2 = (lvl << 1) - 1;
209 for (i__ = lf; i__ <= i__1; ++i__) {
211 ic = iwork[inode + im1];
212 nl = iwork[ndiml + im1];
213 nr = iwork[ndimr + im1];
223 idxqi = idxq + nlf - 1;
227 F77_FUNC(slasd6,SLASD6)(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
228 work[vli], &alpha, &beta, &iwork[idxqi], &perm[
229 perm_offset], &givptr[1], &givcol[givcol_offset],
230 ldgcol, &givnum[givnum_offset], ldu, &poles[
231 poles_offset], &difl[difl_offset], &difr[difr_offset],
232 &z__[z_offset], &k[1], &c__[1], &s[1], &work[nwork1],
236 F77_FUNC(slasd6,SLASD6)(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
237 work[vli], &alpha, &beta, &iwork[idxqi], &perm[nlf +
238 lvl * perm_dim1], &givptr[j], &givcol[nlf + lvl2 *
239 givcol_dim1], ldgcol, &givnum[nlf + lvl2 *
240 givnum_dim1], ldu, &poles[nlf + lvl2 * poles_dim1], &
241 difl[nlf + lvl * difl_dim1], &difr[nlf + lvl2 *
242 difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[j],
243 &s[j], &work[nwork1], &iwork[iwk], info);