whitespace fixes

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

View File

@ -1,13 +1,13 @@
/* fortran/dlasda.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
@ -296,47 +296,47 @@ f"> */
/* > California at Berkeley, USA */
/* > */
/* ===================================================================== */
/* Subroutine */ int dlasda_(integer *icompq, integer *smlsiz, integer *n,
integer *sqre, doublereal *d__, doublereal *e, 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 dlasda_(integer *icompq, integer *smlsiz, integer *n,
integer *sqre, doublereal *d__, doublereal *e, 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, 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, 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, m, i1, ic, lf, nd, ll, nl, vf, nr, vl, im1, ncc, nlf, nrf,
vfi, iwk, vli, lvl, nru, ndb1, nlp1, lvl2, nrp1;
vfi, iwk, vli, lvl, nru, ndb1, nlp1, lvl2, nrp1;
doublereal beta;
integer idxq, nlvl;
doublereal alpha;
integer inode, ndiml, ndimr, idxqi, itemp;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *);
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *);
integer sqrei;
extern /* Subroutine */ int dlasd6_(integer *, integer *, integer *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, integer *, integer *, integer *,
integer *, doublereal *, integer *, doublereal *, doublereal *,
doublereal *, doublereal *, integer *, doublereal *, doublereal *,
doublereal *, integer *, integer *);
extern /* Subroutine */ int dlasd6_(integer *, integer *, integer *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, integer *, integer *, integer *,
integer *, doublereal *, integer *, doublereal *, doublereal *,
doublereal *, doublereal *, integer *, doublereal *, doublereal *,
doublereal *, integer *, integer *);
integer nwork1, nwork2;
extern /* Subroutine */ int dlasdq_(char *, integer *, integer *, integer
*, integer *, integer *, doublereal *, doublereal *, doublereal *,
integer *, doublereal *, integer *, doublereal *, integer *,
doublereal *, integer *, ftnlen), dlasdt_(integer *, integer *,
integer *, integer *, integer *, integer *, integer *), dlaset_(
char *, integer *, integer *, doublereal *, doublereal *,
doublereal *, integer *, ftnlen), xerbla_(char *, integer *,
ftnlen);
extern /* Subroutine */ int dlasdq_(char *, integer *, integer *, integer
*, integer *, integer *, doublereal *, doublereal *, doublereal *,
integer *, doublereal *, integer *, doublereal *, integer *,
doublereal *, integer *, ftnlen), dlasdt_(integer *, integer *,
integer *, integer *, integer *, integer *, integer *), dlaset_(
char *, integer *, integer *, doublereal *, doublereal *,
doublereal *, integer *, ftnlen), xerbla_(char *, integer *,
ftnlen);
integer smlszp;
@ -402,22 +402,22 @@ f"> */
*info = 0;
if (*icompq < 0 || *icompq > 1) {
*info = -1;
*info = -1;
} else if (*smlsiz < 3) {
*info = -2;
*info = -2;
} else if (*n < 0) {
*info = -3;
*info = -3;
} else if (*sqre < 0 || *sqre > 1) {
*info = -4;
*info = -4;
} else if (*ldu < *n + *sqre) {
*info = -8;
*info = -8;
} else if (*ldgcol < *n) {
*info = -17;
*info = -17;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_((char *)"DLASDA", &i__1, (ftnlen)6);
return 0;
i__1 = -(*info);
xerbla_((char *)"DLASDA", &i__1, (ftnlen)6);
return 0;
}
m = *n + *sqre;
@ -425,16 +425,16 @@ f"> */
/* If the input matrix is too small, call DLASDQ to find the SVD. */
if (*n <= *smlsiz) {
if (*icompq == 0) {
dlasdq_((char *)"U", sqre, n, &c__0, &c__0, &c__0, &d__[1], &e[1], &vt[
vt_offset], ldu, &u[u_offset], ldu, &u[u_offset], ldu, &
work[1], info, (ftnlen)1);
} else {
dlasdq_((char *)"U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset]
, ldu, &u[u_offset], ldu, &u[u_offset], ldu, &work[1],
info, (ftnlen)1);
}
return 0;
if (*icompq == 0) {
dlasdq_((char *)"U", sqre, n, &c__0, &c__0, &c__0, &d__[1], &e[1], &vt[
vt_offset], ldu, &u[u_offset], ldu, &u[u_offset], ldu, &
work[1], info, (ftnlen)1);
} else {
dlasdq_((char *)"U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset]
, ldu, &u[u_offset], ldu, &u[u_offset], ldu, &work[1],
info, (ftnlen)1);
}
return 0;
}
/* Book-keeping and set up the computation tree. */
@ -454,8 +454,8 @@ f"> */
nwork1 = vl + m;
nwork2 = nwork1 + smlszp * smlszp;
dlasdt_(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
smlsiz);
dlasdt_(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
smlsiz);
/* for the nodes on bottom level of the tree, solve */
/* their subproblems by DLASDQ. */
@ -470,84 +470,84 @@ 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];
nlp1 = nl + 1;
nr = iwork[ndimr + i1];
nlf = ic - nl;
nrf = ic + 1;
idxqi = idxq + nlf - 2;
vfi = vf + nlf - 1;
vli = vl + nlf - 1;
sqrei = 1;
if (*icompq == 0) {
dlaset_((char *)"A", &nlp1, &nlp1, &c_b11, &c_b12, &work[nwork1], &smlszp,
(ftnlen)1);
dlasdq_((char *)"U", &sqrei, &nl, &nlp1, &nru, &ncc, &d__[nlf], &e[nlf], &
work[nwork1], &smlszp, &work[nwork2], &nl, &work[nwork2],
&nl, &work[nwork2], info, (ftnlen)1);
itemp = nwork1 + nl * smlszp;
dcopy_(&nlp1, &work[nwork1], &c__1, &work[vfi], &c__1);
dcopy_(&nlp1, &work[itemp], &c__1, &work[vli], &c__1);
} else {
dlaset_((char *)"A", &nl, &nl, &c_b11, &c_b12, &u[nlf + u_dim1], ldu, (
ftnlen)1);
dlaset_((char *)"A", &nlp1, &nlp1, &c_b11, &c_b12, &vt[nlf + vt_dim1],
ldu, (ftnlen)1);
dlasdq_((char *)"U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &
vt[nlf + vt_dim1], ldu, &u[nlf + u_dim1], ldu, &u[nlf +
u_dim1], ldu, &work[nwork1], info, (ftnlen)1);
dcopy_(&nlp1, &vt[nlf + vt_dim1], &c__1, &work[vfi], &c__1);
dcopy_(&nlp1, &vt[nlf + nlp1 * vt_dim1], &c__1, &work[vli], &c__1)
;
}
if (*info != 0) {
return 0;
}
i__2 = nl;
for (j = 1; j <= i__2; ++j) {
iwork[idxqi + j] = j;
i1 = i__ - 1;
ic = iwork[inode + i1];
nl = iwork[ndiml + i1];
nlp1 = nl + 1;
nr = iwork[ndimr + i1];
nlf = ic - nl;
nrf = ic + 1;
idxqi = idxq + nlf - 2;
vfi = vf + nlf - 1;
vli = vl + nlf - 1;
sqrei = 1;
if (*icompq == 0) {
dlaset_((char *)"A", &nlp1, &nlp1, &c_b11, &c_b12, &work[nwork1], &smlszp,
(ftnlen)1);
dlasdq_((char *)"U", &sqrei, &nl, &nlp1, &nru, &ncc, &d__[nlf], &e[nlf], &
work[nwork1], &smlszp, &work[nwork2], &nl, &work[nwork2],
&nl, &work[nwork2], info, (ftnlen)1);
itemp = nwork1 + nl * smlszp;
dcopy_(&nlp1, &work[nwork1], &c__1, &work[vfi], &c__1);
dcopy_(&nlp1, &work[itemp], &c__1, &work[vli], &c__1);
} else {
dlaset_((char *)"A", &nl, &nl, &c_b11, &c_b12, &u[nlf + u_dim1], ldu, (
ftnlen)1);
dlaset_((char *)"A", &nlp1, &nlp1, &c_b11, &c_b12, &vt[nlf + vt_dim1],
ldu, (ftnlen)1);
dlasdq_((char *)"U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &
vt[nlf + vt_dim1], ldu, &u[nlf + u_dim1], ldu, &u[nlf +
u_dim1], ldu, &work[nwork1], info, (ftnlen)1);
dcopy_(&nlp1, &vt[nlf + vt_dim1], &c__1, &work[vfi], &c__1);
dcopy_(&nlp1, &vt[nlf + nlp1 * vt_dim1], &c__1, &work[vli], &c__1)
;
}
if (*info != 0) {
return 0;
}
i__2 = nl;
for (j = 1; j <= i__2; ++j) {
iwork[idxqi + j] = j;
/* L10: */
}
if (i__ == nd && *sqre == 0) {
sqrei = 0;
} else {
sqrei = 1;
}
idxqi += nlp1;
vfi += nlp1;
vli += nlp1;
nrp1 = nr + sqrei;
if (*icompq == 0) {
dlaset_((char *)"A", &nrp1, &nrp1, &c_b11, &c_b12, &work[nwork1], &smlszp,
(ftnlen)1);
dlasdq_((char *)"U", &sqrei, &nr, &nrp1, &nru, &ncc, &d__[nrf], &e[nrf], &
work[nwork1], &smlszp, &work[nwork2], &nr, &work[nwork2],
&nr, &work[nwork2], info, (ftnlen)1);
itemp = nwork1 + (nrp1 - 1) * smlszp;
dcopy_(&nrp1, &work[nwork1], &c__1, &work[vfi], &c__1);
dcopy_(&nrp1, &work[itemp], &c__1, &work[vli], &c__1);
} else {
dlaset_((char *)"A", &nr, &nr, &c_b11, &c_b12, &u[nrf + u_dim1], ldu, (
ftnlen)1);
dlaset_((char *)"A", &nrp1, &nrp1, &c_b11, &c_b12, &vt[nrf + vt_dim1],
ldu, (ftnlen)1);
dlasdq_((char *)"U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &
vt[nrf + vt_dim1], ldu, &u[nrf + u_dim1], ldu, &u[nrf +
u_dim1], ldu, &work[nwork1], info, (ftnlen)1);
dcopy_(&nrp1, &vt[nrf + vt_dim1], &c__1, &work[vfi], &c__1);
dcopy_(&nrp1, &vt[nrf + nrp1 * vt_dim1], &c__1, &work[vli], &c__1)
;
}
if (*info != 0) {
return 0;
}
i__2 = nr;
for (j = 1; j <= i__2; ++j) {
iwork[idxqi + j] = j;
}
if (i__ == nd && *sqre == 0) {
sqrei = 0;
} else {
sqrei = 1;
}
idxqi += nlp1;
vfi += nlp1;
vli += nlp1;
nrp1 = nr + sqrei;
if (*icompq == 0) {
dlaset_((char *)"A", &nrp1, &nrp1, &c_b11, &c_b12, &work[nwork1], &smlszp,
(ftnlen)1);
dlasdq_((char *)"U", &sqrei, &nr, &nrp1, &nru, &ncc, &d__[nrf], &e[nrf], &
work[nwork1], &smlszp, &work[nwork2], &nr, &work[nwork2],
&nr, &work[nwork2], info, (ftnlen)1);
itemp = nwork1 + (nrp1 - 1) * smlszp;
dcopy_(&nrp1, &work[nwork1], &c__1, &work[vfi], &c__1);
dcopy_(&nrp1, &work[itemp], &c__1, &work[vli], &c__1);
} else {
dlaset_((char *)"A", &nr, &nr, &c_b11, &c_b12, &u[nrf + u_dim1], ldu, (
ftnlen)1);
dlaset_((char *)"A", &nrp1, &nrp1, &c_b11, &c_b12, &vt[nrf + vt_dim1],
ldu, (ftnlen)1);
dlasdq_((char *)"U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &
vt[nrf + vt_dim1], ldu, &u[nrf + u_dim1], ldu, &u[nrf +
u_dim1], ldu, &work[nwork1], info, (ftnlen)1);
dcopy_(&nrp1, &vt[nrf + vt_dim1], &c__1, &work[vfi], &c__1);
dcopy_(&nrp1, &vt[nrf + nrp1 * vt_dim1], &c__1, &work[vli], &c__1)
;
}
if (*info != 0) {
return 0;
}
i__2 = nr;
for (j = 1; j <= i__2; ++j) {
iwork[idxqi + j] = j;
/* L20: */
}
}
/* L30: */
}
@ -555,61 +555,61 @@ f"> */
j = pow_ii(&c__2, &nlvl);
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;
if (i__ == ll) {
sqrei = *sqre;
} else {
sqrei = 1;
}
vfi = vf + nlf - 1;
vli = vl + nlf - 1;
idxqi = idxq + nlf - 1;
alpha = d__[ic];
beta = e[ic];
if (*icompq == 0) {
dlasd6_(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
work[vli], &alpha, &beta, &iwork[idxqi], &perm[
perm_offset], &givptr[1], &givcol[givcol_offset],
ldgcol, &givnum[givnum_offset], ldu, &poles[
poles_offset], &difl[difl_offset], &difr[difr_offset],
&z__[z_offset], &k[1], &c__[1], &s[1], &work[nwork1],
&iwork[iwk], info);
} else {
--j;
dlasd6_(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
work[vli], &alpha, &beta, &iwork[idxqi], &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[nwork1], &iwork[iwk], info);
}
if (*info != 0) {
return 0;
}
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;
if (i__ == ll) {
sqrei = *sqre;
} else {
sqrei = 1;
}
vfi = vf + nlf - 1;
vli = vl + nlf - 1;
idxqi = idxq + nlf - 1;
alpha = d__[ic];
beta = e[ic];
if (*icompq == 0) {
dlasd6_(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
work[vli], &alpha, &beta, &iwork[idxqi], &perm[
perm_offset], &givptr[1], &givcol[givcol_offset],
ldgcol, &givnum[givnum_offset], ldu, &poles[
poles_offset], &difl[difl_offset], &difr[difr_offset],
&z__[z_offset], &k[1], &c__[1], &s[1], &work[nwork1],
&iwork[iwk], info);
} else {
--j;
dlasd6_(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
work[vli], &alpha, &beta, &iwork[idxqi], &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[nwork1], &iwork[iwk], info);
}
if (*info != 0) {
return 0;
}
/* L40: */
}
}
/* L50: */
}
@ -620,5 +620,5 @@ f"> */
} /* dlasda_ */
#ifdef __cplusplus
}
}
#endif