ICODE-ADC/lammps
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

whitespace fixes

Browse Source
This commit is contained in:
Axel Kohlmeyer
2022-12-28 13:47:11 -05:00
parent a894cbfbb7
commit 1e8b2ad5a0
194 changed files with 24511 additions and 24511 deletions
Download Patch File Download Diff File Expand all files Collapse all files

274
lib/linalg/dlalsa.cpp
View File

@ -1,13 +1,13 @@
/* fortran/dlalsa.f -- translated by f2c (version 20200916).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
http://www.netlib.org/f2c/libf2c.zip
*/
#ifdef __cplusplus
@ -286,40 +286,40 @@ f"> */
/* > Osni Marques, LBNL/NERSC, USA \n */
/* ===================================================================== */
/* Subroutine */ int dlalsa_(integer *icompq, integer *smlsiz, integer *n,
integer *nrhs, doublereal *b, integer *ldb, doublereal *bx, integer *
ldbx, doublereal *u, integer *ldu, doublereal *vt, integer *k,
doublereal *difl, doublereal *difr, doublereal *z__, doublereal *
poles, integer *givptr, integer *givcol, integer *ldgcol, integer *
perm, doublereal *givnum, doublereal *c__, doublereal *s, doublereal *
work, integer *iwork, integer *info)
/* Subroutine */ int dlalsa_(integer *icompq, integer *smlsiz, integer *n,
integer *nrhs, doublereal *b, integer *ldb, doublereal *bx, integer *
ldbx, doublereal *u, integer *ldu, doublereal *vt, integer *k,
doublereal *difl, doublereal *difr, doublereal *z__, doublereal *
poles, integer *givptr, integer *givcol, integer *ldgcol, integer *
perm, doublereal *givnum, doublereal *c__, doublereal *s, doublereal *
work, integer *iwork, integer *info)
{
/* System generated locals */
integer givcol_dim1, givcol_offset, perm_dim1, perm_offset, b_dim1,
b_offset, bx_dim1, bx_offset, difl_dim1, difl_offset, difr_dim1,
difr_offset, givnum_dim1, givnum_offset, poles_dim1, poles_offset,
u_dim1, u_offset, vt_dim1, vt_offset, z_dim1, z_offset, i__1,
i__2;
integer givcol_dim1, givcol_offset, perm_dim1, perm_offset, b_dim1,
b_offset, bx_dim1, bx_offset, difl_dim1, difl_offset, difr_dim1,
difr_offset, givnum_dim1, givnum_offset, poles_dim1, poles_offset,
u_dim1, u_offset, vt_dim1, vt_offset, z_dim1, z_offset, i__1,
i__2;
/* Builtin functions */
integer pow_ii(integer *, integer *);
/* Local variables */
integer i__, j, i1, ic, lf, nd, ll, nl, nr, im1, nlf, nrf, lvl, ndb1,
nlp1, lvl2, nrp1, nlvl, sqre;
extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
integer *, doublereal *, doublereal *, integer *, doublereal *,
integer *, doublereal *, doublereal *, integer *, ftnlen, ftnlen);
integer i__, j, i1, ic, lf, nd, ll, nl, nr, im1, nlf, nrf, lvl, ndb1,
nlp1, lvl2, nrp1, nlvl, sqre;
extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
integer *, doublereal *, doublereal *, integer *, doublereal *,
integer *, doublereal *, doublereal *, integer *, ftnlen, ftnlen);
integer inode, ndiml, ndimr;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *), dlals0_(integer *, integer *, integer *,
integer *, integer *, doublereal *, integer *, doublereal *,
integer *, integer *, integer *, integer *, integer *, doublereal
*, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, doublereal *, doublereal *, doublereal *,
integer *), dlasdt_(integer *, integer *, integer *, integer *,
integer *, integer *, integer *), xerbla_(char *, integer *,
ftnlen);
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *), dlals0_(integer *, integer *, integer *,
integer *, integer *, doublereal *, integer *, doublereal *,
integer *, integer *, integer *, integer *, integer *, doublereal
*, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, doublereal *, doublereal *, doublereal *,
integer *), dlasdt_(integer *, integer *, integer *, integer *,
integer *, integer *, integer *), xerbla_(char *, integer *,
ftnlen);
/* -- LAPACK computational routine -- */
@ -388,26 +388,26 @@ f"> */
*info = 0;
if (*icompq < 0 || *icompq > 1) {
*info = -1;
*info = -1;
} else if (*smlsiz < 3) {
*info = -2;
*info = -2;
} else if (*n < *smlsiz) {
*info = -3;
*info = -3;
} else if (*nrhs < 1) {
*info = -4;
*info = -4;
} else if (*ldb < *n) {
*info = -6;
*info = -6;
} else if (*ldbx < *n) {
*info = -8;
*info = -8;
} else if (*ldu < *n) {
*info = -10;
*info = -10;
} else if (*ldgcol < *n) {
*info = -19;
*info = -19;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_((char *)"DLALSA", &i__1, (ftnlen)6);
return 0;
i__1 = -(*info);
xerbla_((char *)"DLALSA", &i__1, (ftnlen)6);
return 0;
}
/* Book-keeping and setting up the computation tree. */
@ -416,14 +416,14 @@ f"> */
ndiml = inode + *n;
ndimr = ndiml + *n;
dlasdt_(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
smlsiz);
dlasdt_(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
smlsiz);
/* The following code applies back the left singular vector factors. */
/* For applying back the right singular vector factors, go to 50. */
if (*icompq == 1) {
goto L50;
goto L50;
}
/* The nodes on the bottom level of the tree were solved */
@ -441,18 +441,18 @@ f"> */
/* NLF: starting row of the left subproblem */
/* NRF: starting row of the right subproblem */
i1 = i__ - 1;
ic = iwork[inode + i1];
nl = iwork[ndiml + i1];
nr = iwork[ndimr + i1];
nlf = ic - nl;
nrf = ic + 1;
dgemm_((char *)"T", (char *)"N", &nl, nrhs, &nl, &c_b7, &u[nlf + u_dim1], ldu, &b[nlf
+ b_dim1], ldb, &c_b8, &bx[nlf + bx_dim1], ldbx, (ftnlen)1, (
ftnlen)1);
dgemm_((char *)"T", (char *)"N", &nr, nrhs, &nr, &c_b7, &u[nrf + u_dim1], ldu, &b[nrf
+ b_dim1], ldb, &c_b8, &bx[nrf + bx_dim1], ldbx, (ftnlen)1, (
ftnlen)1);
i1 = i__ - 1;
ic = iwork[inode + i1];
nl = iwork[ndiml + i1];
nr = iwork[ndimr + i1];
nlf = ic - nl;
nrf = ic + 1;
dgemm_((char *)"T", (char *)"N", &nl, nrhs, &nl, &c_b7, &u[nlf + u_dim1], ldu, &b[nlf
+ b_dim1], ldb, &c_b8, &bx[nlf + bx_dim1], ldbx, (ftnlen)1, (
ftnlen)1);
dgemm_((char *)"T", (char *)"N", &nr, nrhs, &nr, &c_b7, &u[nrf + u_dim1], ldu, &b[nrf
+ b_dim1], ldb, &c_b8, &bx[nrf + bx_dim1], ldbx, (ftnlen)1, (
ftnlen)1);
/* L10: */
}
@ -461,8 +461,8 @@ f"> */
i__1 = nd;
for (i__ = 1; i__ <= i__1; ++i__) {
ic = iwork[inode + i__ - 1];
dcopy_(nrhs, &b[ic + b_dim1], ldb, &bx[ic + bx_dim1], ldbx);
ic = iwork[inode + i__ - 1];
dcopy_(nrhs, &b[ic + b_dim1], ldb, &bx[ic + bx_dim1], ldbx);
/* L20: */
}
@ -473,37 +473,37 @@ f"> */
sqre = 0;
for (lvl = nlvl; lvl >= 1; --lvl) {
lvl2 = (lvl << 1) - 1;
lvl2 = (lvl << 1) - 1;
/* find the first node LF and last node LL on */
/* the current level LVL */
if (lvl == 1) {
lf = 1;
ll = 1;
} else {
i__1 = lvl - 1;
lf = pow_ii(&c__2, &i__1);
ll = (lf << 1) - 1;
}
i__1 = ll;
for (i__ = lf; i__ <= i__1; ++i__) {
im1 = i__ - 1;
ic = iwork[inode + im1];
nl = iwork[ndiml + im1];
nr = iwork[ndimr + im1];
nlf = ic - nl;
nrf = ic + 1;
--j;
dlals0_(icompq, &nl, &nr, &sqre, nrhs, &bx[nlf + bx_dim1], ldbx, &
b[nlf + b_dim1], ldb, &perm[nlf + lvl * perm_dim1], &
givptr[j], &givcol[nlf + lvl2 * givcol_dim1], ldgcol, &
givnum[nlf + lvl2 * givnum_dim1], ldu, &poles[nlf + lvl2 *
poles_dim1], &difl[nlf + lvl * difl_dim1], &difr[nlf +
lvl2 * difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[
j], &s[j], &work[1], info);
if (lvl == 1) {
lf = 1;
ll = 1;
} else {
i__1 = lvl - 1;
lf = pow_ii(&c__2, &i__1);
ll = (lf << 1) - 1;
}
i__1 = ll;
for (i__ = lf; i__ <= i__1; ++i__) {
im1 = i__ - 1;
ic = iwork[inode + im1];
nl = iwork[ndiml + im1];
nr = iwork[ndimr + im1];
nlf = ic - nl;
nrf = ic + 1;
--j;
dlals0_(icompq, &nl, &nr, &sqre, nrhs, &bx[nlf + bx_dim1], ldbx, &
b[nlf + b_dim1], ldb, &perm[nlf + lvl * perm_dim1], &
givptr[j], &givcol[nlf + lvl2 * givcol_dim1], ldgcol, &
givnum[nlf + lvl2 * givnum_dim1], ldu, &poles[nlf + lvl2 *
poles_dim1], &difl[nlf + lvl * difl_dim1], &difr[nlf +
lvl2 * difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[
j], &s[j], &work[1], info);
/* L30: */
}
}
/* L40: */
}
goto L90;
@ -518,42 +518,42 @@ L50:
j = 0;
i__1 = nlvl;
for (lvl = 1; lvl <= i__1; ++lvl) {
lvl2 = (lvl << 1) - 1;
lvl2 = (lvl << 1) - 1;
/* Find the first node LF and last node LL on */
/* the current level LVL. */
if (lvl == 1) {
lf = 1;
ll = 1;
} else {
i__2 = lvl - 1;
lf = pow_ii(&c__2, &i__2);
ll = (lf << 1) - 1;
}
i__2 = lf;
for (i__ = ll; i__ >= i__2; --i__) {
im1 = i__ - 1;
ic = iwork[inode + im1];
nl = iwork[ndiml + im1];
nr = iwork[ndimr + im1];
nlf = ic - nl;
nrf = ic + 1;
if (i__ == ll) {
sqre = 0;
} else {
sqre = 1;
}
++j;
dlals0_(icompq, &nl, &nr, &sqre, nrhs, &b[nlf + b_dim1], ldb, &bx[
nlf + bx_dim1], ldbx, &perm[nlf + lvl * perm_dim1], &
givptr[j], &givcol[nlf + lvl2 * givcol_dim1], ldgcol, &
givnum[nlf + lvl2 * givnum_dim1], ldu, &poles[nlf + lvl2 *
poles_dim1], &difl[nlf + lvl * difl_dim1], &difr[nlf +
lvl2 * difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[
j], &s[j], &work[1], info);
if (lvl == 1) {
lf = 1;
ll = 1;
} else {
i__2 = lvl - 1;
lf = pow_ii(&c__2, &i__2);
ll = (lf << 1) - 1;
}
i__2 = lf;
for (i__ = ll; i__ >= i__2; --i__) {
im1 = i__ - 1;
ic = iwork[inode + im1];
nl = iwork[ndiml + im1];
nr = iwork[ndimr + im1];
nlf = ic - nl;
nrf = ic + 1;
if (i__ == ll) {
sqre = 0;
} else {
sqre = 1;
}
++j;
dlals0_(icompq, &nl, &nr, &sqre, nrhs, &b[nlf + b_dim1], ldb, &bx[
nlf + bx_dim1], ldbx, &perm[nlf + lvl * perm_dim1], &
givptr[j], &givcol[nlf + lvl2 * givcol_dim1], ldgcol, &
givnum[nlf + lvl2 * givnum_dim1], ldu, &poles[nlf + lvl2 *
poles_dim1], &difl[nlf + lvl * difl_dim1], &difr[nlf +
lvl2 * difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[
j], &s[j], &work[1], info);
/* L60: */
}
}
/* L70: */
}
@ -564,24 +564,24 @@ L50:
ndb1 = (nd + 1) / 2;
i__1 = nd;
for (i__ = ndb1; i__ <= i__1; ++i__) {
i1 = i__ - 1;
ic = iwork[inode + i1];
nl = iwork[ndiml + i1];
nr = iwork[ndimr + i1];
nlp1 = nl + 1;
if (i__ == nd) {
nrp1 = nr;
} else {
nrp1 = nr + 1;
}
nlf = ic - nl;
nrf = ic + 1;
dgemm_((char *)"T", (char *)"N", &nlp1, nrhs, &nlp1, &c_b7, &vt[nlf + vt_dim1], ldu, &
b[nlf + b_dim1], ldb, &c_b8, &bx[nlf + bx_dim1], ldbx, (
ftnlen)1, (ftnlen)1);
dgemm_((char *)"T", (char *)"N", &nrp1, nrhs, &nrp1, &c_b7, &vt[nrf + vt_dim1], ldu, &
b[nrf + b_dim1], ldb, &c_b8, &bx[nrf + bx_dim1], ldbx, (
ftnlen)1, (ftnlen)1);
i1 = i__ - 1;
ic = iwork[inode + i1];
nl = iwork[ndiml + i1];
nr = iwork[ndimr + i1];
nlp1 = nl + 1;
if (i__ == nd) {
nrp1 = nr;
} else {
nrp1 = nr + 1;
}
nlf = ic - nl;
nrf = ic + 1;
dgemm_((char *)"T", (char *)"N", &nlp1, nrhs, &nlp1, &c_b7, &vt[nlf + vt_dim1], ldu, &
b[nlf + b_dim1], ldb, &c_b8, &bx[nlf + bx_dim1], ldbx, (
ftnlen)1, (ftnlen)1);
dgemm_((char *)"T", (char *)"N", &nrp1, nrhs, &nrp1, &c_b7, &vt[nrf + vt_dim1], ldu, &
b[nrf + b_dim1], ldb, &c_b8, &bx[nrf + bx_dim1], ldbx, (
ftnlen)1, (ftnlen)1);
/* L80: */
}
@ -594,5 +594,5 @@ L90:
} /* dlalsa_ */
#ifdef __cplusplus
}
}
#endif