4 #include "gmx_lapack.h"
8 F77_FUNC(dlasdq,DLASDQ)(const char *uplo,
25 const char xuplo=toupper(*uplo);
26 int c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1,
41 vt_offset = 1 + vt_dim1;
44 u_offset = 1 + u_dim1;
47 c_offset = 1 + c_dim1;
60 itmp1 = (*n > 1) ? *n : 1;
61 itmp2 = (*nru > 1) ? *nru : 1;
64 } else if (*sqre < 0 || *sqre > 1) {
68 } else if (*ncvt < 0) {
70 } else if (*nru < 0) {
72 } else if (*ncc < 0) {
74 } else if ((*ncvt == 0 && *ldvt < 1) || (*ncvt > 0 && *ldvt < itmp1)) {
76 } else if (*ldu < itmp2) {
78 } else if ((*ncc == 0 && *ldc < 1) || (*ncc > 0 && *ldc < itmp1)) {
88 rotate = *ncvt > 0 || *nru > 0 || *ncc > 0;
92 if (iuplo == 1 && sqre1 == 1) {
94 for (i__ = 1; i__ <= i__1; ++i__) {
95 F77_FUNC(dlartg,DLARTG)(&d__[i__], &e[i__], &cs, &sn, &r__);
97 e[i__] = sn * d__[i__ + 1];
98 d__[i__ + 1] = cs * d__[i__ + 1];
104 F77_FUNC(dlartg,DLARTG)(&d__[*n], &e[*n], &cs, &sn, &r__);
115 F77_FUNC(dlasr,DLASR)("L", "V", "F", &np1, ncvt, &work[1], &work[np1], &vt[
121 for (i__ = 1; i__ <= i__1; ++i__) {
122 F77_FUNC(dlartg,DLARTG)(&d__[i__], &e[i__], &cs, &sn, &r__);
124 e[i__] = sn * d__[i__ + 1];
125 d__[i__ + 1] = cs * d__[i__ + 1];
133 F77_FUNC(dlartg,DLARTG)(&d__[*n], &e[*n], &cs, &sn, &r__);
142 F77_FUNC(dlasr,DLASR)("R", "V", "F", nru, n, &work[1], &work[np1], &u[
145 F77_FUNC(dlasr,DLASR)("R", "V", "F", nru, &np1, &work[1], &work[np1], &u[
151 F77_FUNC(dlasr,DLASR)("L", "V", "F", n, ncc, &work[1], &work[np1], &c__[
154 F77_FUNC(dlasr,DLASR)("L", "V", "F", &np1, ncc, &work[1], &work[np1], &c__[
160 F77_FUNC(dbdsqr,DBDSQR)("U", n, ncvt, nru, ncc, &d__[1], &e[1], &vt[vt_offset], ldvt, &u[
161 u_offset], ldu, &c__[c_offset], ldc, &work[1], info);
164 for (i__ = 1; i__ <= i__1; ++i__) {
169 for (j = i__ + 1; j <= i__2; ++j) {
176 d__[isub] = d__[i__];
179 F77_FUNC(dswap,DSWAP)(ncvt, &vt[isub + vt_dim1], ldvt, &vt[i__ + vt_dim1],
183 F77_FUNC(dswap,DSWAP)(nru, &u[isub * u_dim1 + 1], &c__1, &u[i__ * u_dim1 + 1]
187 F77_FUNC(dswap,DSWAP)(ncc, &c__[isub + c_dim1], ldc, &c__[i__ + c_dim1], ldc)