2 * This file is part of the GROMACS molecular simulation package.
4 * Copyright (c) 2012, by the GROMACS development team, led by
5 * David van der Spoel, Berk Hess, Erik Lindahl, and including many
6 * others, as listed in the AUTHORS file in the top-level source
7 * directory and at http://www.gromacs.org.
9 * GROMACS is free software; you can redistribute it and/or
10 * modify it under the terms of the GNU Lesser General Public License
11 * as published by the Free Software Foundation; either version 2.1
12 * of the License, or (at your option) any later version.
14 * GROMACS is distributed in the hope that it will be useful,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 * Lesser General Public License for more details.
19 * You should have received a copy of the GNU Lesser General Public
20 * License along with GROMACS; if not, see
21 * http://www.gnu.org/licenses, or write to the Free Software Foundation,
22 * Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
24 * If you want to redistribute modifications to GROMACS, please
25 * consider that scientific software is very special. Version
26 * control is crucial - bugs must be traceable. We will be happy to
27 * consider code for inclusion in the official distribution, but
28 * derived work must not be called official GROMACS. Details are found
29 * in the README & COPYING files - if they are missing, get the
30 * official version at http://www.gromacs.org.
32 * To help us fund GROMACS development, we humbly ask that you cite
33 * the research papers on the package. Check out http://www.gromacs.org.
36 #include "gmx_lapack.h"
39 F77_FUNC(dlasda,DLASDA)(int *icompq,
64 int givcol_dim1, givcol_offset, perm_dim1, perm_offset, difl_dim1,
65 difl_offset, difr_dim1, difr_offset, givnum_dim1, givnum_offset,
66 poles_dim1, poles_offset, u_dim1, u_offset, vt_dim1, vt_offset,
67 z_dim1, z_offset, i__1, i__2;
69 int i__, j, m, i1, ic, lf, nd, ll, nl, vf, nr, vl, im1, ncc,
70 nlf, nrf, vfi, iwk, vli, lvl, nru, ndb1, nlp1, lvl2, nrp1;
74 int inode, ndiml, ndimr, idxqi, itemp;
85 givnum_offset = 1 + givnum_dim1;
86 givnum -= givnum_offset;
88 poles_offset = 1 + poles_dim1;
89 poles -= poles_offset;
91 z_offset = 1 + z_dim1;
94 difr_offset = 1 + difr_dim1;
97 difl_offset = 1 + difl_dim1;
100 vt_offset = 1 + vt_dim1;
103 u_offset = 1 + u_dim1;
108 perm_offset = 1 + perm_dim1;
110 givcol_dim1 = *ldgcol;
111 givcol_offset = 1 + givcol_dim1;
112 givcol -= givcol_offset;
123 F77_FUNC(dlasdq,DLASDQ)("U", sqre, n, &c__0, &c__0, &c__0, &d__[1], &e[1], &vt[
124 vt_offset], ldu, &u[u_offset], ldu, &u[u_offset], ldu, &
127 F77_FUNC(dlasdq,DLASDQ)("U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset]
128 , ldu, &u[u_offset], ldu, &u[u_offset], ldu, &work[1],
143 smlszp = *smlsiz + 1;
147 nwork2 = nwork1 + smlszp * smlszp;
149 F77_FUNC(dlasdt,DLASDT)(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
154 for (i__ = ndb1; i__ <= i__1; ++i__) {
156 ic = iwork[inode + i1];
157 nl = iwork[ndiml + i1];
159 nr = iwork[ndimr + i1];
162 idxqi = idxq + nlf - 2;
167 F77_FUNC(dlaset,DLASET)("A", &nlp1, &nlp1, &zero, &one, &work[nwork1], &smlszp);
168 F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nl, &nlp1, &nru, &ncc, &d__[nlf], &e[nlf], &
169 work[nwork1], &smlszp, &work[nwork2], &nl, &work[nwork2],
170 &nl, &work[nwork2], info);
171 itemp = nwork1 + nl * smlszp;
172 F77_FUNC(dcopy,DCOPY)(&nlp1, &work[nwork1], &c__1, &work[vfi], &c__1);
173 F77_FUNC(dcopy,DCOPY)(&nlp1, &work[itemp], &c__1, &work[vli], &c__1);
175 F77_FUNC(dlaset,DLASET)("A", &nl, &nl, &zero, &one, &u[nlf + u_dim1], ldu);
176 F77_FUNC(dlaset,DLASET)("A", &nlp1, &nlp1, &zero, &one, &vt[nlf + vt_dim1],
178 F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &
179 vt[nlf + vt_dim1], ldu, &u[nlf + u_dim1], ldu, &u[nlf +
180 u_dim1], ldu, &work[nwork1], info);
181 F77_FUNC(dcopy,DCOPY)(&nlp1, &vt[nlf + vt_dim1], &c__1, &work[vfi], &c__1);
182 F77_FUNC(dcopy,DCOPY)(&nlp1, &vt[nlf + nlp1 * vt_dim1], &c__1, &work[vli], &c__1)
189 for (j = 1; j <= i__2; ++j) {
190 iwork[idxqi + j] = j;
192 if (i__ == nd && *sqre == 0) {
202 F77_FUNC(dlaset,DLASET)("A", &nrp1, &nrp1, &zero, &one, &work[nwork1], &smlszp);
203 F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nr, &nrp1, &nru, &ncc, &d__[nrf], &e[nrf], &
204 work[nwork1], &smlszp, &work[nwork2], &nr, &work[nwork2],
205 &nr, &work[nwork2], info);
206 itemp = nwork1 + (nrp1 - 1) * smlszp;
207 F77_FUNC(dcopy,DCOPY)(&nrp1, &work[nwork1], &c__1, &work[vfi], &c__1);
208 F77_FUNC(dcopy,DCOPY)(&nrp1, &work[itemp], &c__1, &work[vli], &c__1);
210 F77_FUNC(dlaset,DLASET)("A", &nr, &nr, &zero, &one, &u[nrf + u_dim1], ldu);
211 F77_FUNC(dlaset,DLASET)("A", &nrp1, &nrp1, &zero, &one, &vt[nrf + vt_dim1],
213 F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &
214 vt[nrf + vt_dim1], ldu, &u[nrf + u_dim1], ldu, &u[nrf +
215 u_dim1], ldu, &work[nwork1], info);
216 F77_FUNC(dcopy,DCOPY)(&nrp1, &vt[nrf + vt_dim1], &c__1, &work[vfi], &c__1);
217 F77_FUNC(dcopy,DCOPY)(&nrp1, &vt[nrf + nrp1 * vt_dim1], &c__1, &work[vli], &c__1)
224 for (j = 1; j <= i__2; ++j) {
225 iwork[idxqi + j] = j;
231 for (lvl = nlvl; lvl >= 1; --lvl) {
232 lvl2 = (lvl << 1) - 1;
243 for (i__ = lf; i__ <= i__1; ++i__) {
245 ic = iwork[inode + im1];
246 nl = iwork[ndiml + im1];
247 nr = iwork[ndimr + im1];
257 idxqi = idxq + nlf - 1;
261 F77_FUNC(dlasd6,DLASD6)(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
262 work[vli], &alpha, &beta, &iwork[idxqi], &perm[
263 perm_offset], &givptr[1], &givcol[givcol_offset],
264 ldgcol, &givnum[givnum_offset], ldu, &poles[
265 poles_offset], &difl[difl_offset], &difr[difr_offset],
266 &z__[z_offset], &k[1], &c__[1], &s[1], &work[nwork1],
270 F77_FUNC(dlasd6,DLASD6)(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
271 work[vli], &alpha, &beta, &iwork[idxqi], &perm[nlf +
272 lvl * perm_dim1], &givptr[j], &givcol[nlf + lvl2 *
273 givcol_dim1], ldgcol, &givnum[nlf + lvl2 *
274 givnum_dim1], ldu, &poles[nlf + lvl2 * poles_dim1], &
275 difl[nlf + lvl * difl_dim1], &difr[nlf + lvl2 *
276 difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[j],
277 &s[j], &work[nwork1], &iwork[iwk], info);