2 * This file is part of the GROMACS molecular simulation package.
4 * Copyright (c) 2012,2013, 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.
35 #include "gmx_lapack.h"
38 F77_FUNC(dlasd0,DLASD0)(int *n,
51 int u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
53 int i__, j, m, i1, ic, lf, nd, ll, nl, nr, im1, ncc, nlf, nrf,
54 iwk, lvl, ndb1, nlp1, nrp1;
58 int inode, ndiml, idxqc, ndimr, itemp, sqrei;
65 u_offset = 1 + u_dim1;
68 vt_offset = 1 + vt_dim1;
77 } else if (*sqre < 0 || *sqre > 1) {
85 } else if (*ldvt < m) {
87 } else if (*smlsiz < 3) {
96 F77_FUNC(dlasdq,DLASDQ)("U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset],
97 ldvt, &u[u_offset], ldu, &u[u_offset], ldu, &work[1], info);
106 F77_FUNC(dlasdt,DLASDT)(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
112 for (i__ = ndb1; i__ <= i__1; ++i__) {
115 ic = iwork[inode + i1];
116 nl = iwork[ndiml + i1];
118 nr = iwork[ndimr + i1];
123 F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &vt[
124 nlf + nlf * vt_dim1], ldvt, &u[nlf + nlf * u_dim1], ldu, &u[
125 nlf + nlf * u_dim1], ldu, &work[1], info);
129 itemp = idxq + nlf - 2;
131 for (j = 1; j <= i__2; ++j) {
132 iwork[itemp + j] = j;
140 F77_FUNC(dlasdq,DLASDQ)("U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &vt[
141 nrf + nrf * vt_dim1], ldvt, &u[nrf + nrf * u_dim1], ldu, &u[
142 nrf + nrf * u_dim1], ldu, &work[1], info);
148 for (j = 1; j <= i__2; ++j) {
149 iwork[itemp + j - 1] = j;
153 for (lvl = nlvl; lvl >= 1; --lvl) {
164 for (i__ = lf; i__ <= i__1; ++i__) {
166 ic = iwork[inode + im1];
167 nl = iwork[ndiml + im1];
168 nr = iwork[ndimr + im1];
170 if (*sqre == 0 && i__ == ll) {
175 idxqc = idxq + nlf - 1;
178 F77_FUNC(dlasd1,DLASD1)(&nl, &nr, &sqrei, &d__[nlf], &alpha, &beta, &u[nlf + nlf *
179 u_dim1], ldu, &vt[nlf + nlf * vt_dim1], ldvt, &iwork[
180 idxqc], &iwork[iwk], &work[1], info);