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

update linalg to version 1.4 corresponding to LAPACK 3.12.1

Browse Source
This commit is contained in:
Axel Kohlmeyer
2025-01-08 15:52:30 -05:00
parent 0abb371fbe
commit 8ec9f37611
100 changed files with 1424 additions and 2031 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
lib/linalg/dbdsqr.cpp
View File

@ -471,6 +471,9 @@ L90:
L160: L160:
i__1 = *n; i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
if (d__[i__] == 0.) {
d__[i__] = 0.;
}
if (d__[i__] < 0.) { if (d__[i__] < 0.) {
d__[i__] = -d__[i__]; d__[i__] = -d__[i__];
if (*ncvt > 0) { if (*ncvt > 0) {

478
lib/linalg/dgebal.cpp
View File

@ -3,17 +3,15 @@ extern "C" {
#endif #endif
#include "lmp_f2c.h" #include "lmp_f2c.h"
static integer c__1 = 1; static integer c__1 = 1;
static integer c__0 = 0;
static integer c_n1 = -1;
int dgebal_(char *job, integer *n, doublereal *a, integer *lda, integer *ilo, integer *ihi, int dgebal_(char *job, integer *n, doublereal *a, integer *lda, integer *ilo, integer *ihi,
doublereal *scale, integer *info, ftnlen job_len) doublereal *scale, integer *info, ftnlen job_len)
{ {
integer a_dim1, a_offset, i__1, i__2; integer a_dim1, a_offset, i__1, i__2;
doublereal d__1, d__2; doublereal d__1, d__2;
doublereal c__, f, g; doublereal c__, f, g;
integer i__, j, k, l, m; integer i__, j, k, l;
doublereal r__, s, ca, ra; doublereal r__, s, ca, ra;
integer ica, ira, iexc; integer ica, ira;
extern doublereal dnrm2_(integer *, doublereal *, integer *); extern doublereal dnrm2_(integer *, doublereal *, integer *);
extern int dscal_(integer *, doublereal *, doublereal *, integer *); extern int dscal_(integer *, doublereal *, doublereal *, integer *);
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
@ -23,7 +21,7 @@ int dgebal_(char *job, integer *n, doublereal *a, integer *lda, integer *ilo, in
extern integer idamax_(integer *, doublereal *, integer *); extern integer idamax_(integer *, doublereal *, integer *);
extern logical disnan_(doublereal *); extern logical disnan_(doublereal *);
extern int xerbla_(char *, integer *, ftnlen); extern int xerbla_(char *, integer *, ftnlen);
logical noconv; logical noconv, canswap;
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -42,93 +40,95 @@ int dgebal_(char *job, integer *n, doublereal *a, integer *lda, integer *ilo, in
xerbla_((char *)"DGEBAL", &i__1, (ftnlen)6); xerbla_((char *)"DGEBAL", &i__1, (ftnlen)6);
return 0; return 0;
} }
k = 1;
l = *n;
if (*n == 0) { if (*n == 0) {
goto L210; *ilo = 1;
*ihi = 0;
return 0;
} }
if (lsame_(job, (char *)"N", (ftnlen)1, (ftnlen)1)) { if (lsame_(job, (char *)"N", (ftnlen)1, (ftnlen)1)) {
i__1 = *n; i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
scale[i__] = 1.; scale[i__] = 1.;
} }
goto L210; *ilo = 1;
*ihi = *n;
return 0;
} }
if (lsame_(job, (char *)"S", (ftnlen)1, (ftnlen)1)) { k = 1;
goto L120; l = *n;
} if (!lsame_(job, (char *)"S", (ftnlen)1, (ftnlen)1)) {
goto L50; noconv = TRUE_;
L20: while (noconv) {
scale[m] = (doublereal)j; noconv = FALSE_;
if (j == m) { for (i__ = l; i__ >= 1; --i__) {
goto L30; canswap = TRUE_;
}
dswap_(&l, &a[j * a_dim1 + 1], &c__1, &a[m * a_dim1 + 1], &c__1);
i__1 = *n - k + 1;
dswap_(&i__1, &a[j + k * a_dim1], lda, &a[m + k * a_dim1], lda);
L30:
switch (iexc) {
case 1:
goto L40;
case 2:
goto L80;
}
L40:
if (l == 1) {
goto L210;
}
--l;
L50:
for (j = l; j >= 1; --j) {
i__1 = l; i__1 = l;
for (i__ = 1; i__ <= i__1; ++i__) { for (j = 1; j <= i__1; ++j) {
if (i__ == j) { if (i__ != j && a[i__ + j * a_dim1] != 0.) {
goto L60; canswap = FALSE_;
}
if (a[j + i__ * a_dim1] != 0.) {
goto L70;
}
L60:;
}
m = l;
iexc = 1;
goto L20;
L70:;
}
goto L90;
L80:
++k;
L90:
i__1 = l;
for (j = k; j <= i__1; ++j) {
i__2 = l;
for (i__ = k; i__ <= i__2; ++i__) {
if (i__ == j) {
goto L100; goto L100;
} }
if (a[i__ + j * a_dim1] != 0.) {
goto L110;
} }
L100:; L100:
if (canswap) {
scale[l] = (doublereal)i__;
if (i__ != l) {
dswap_(&l, &a[i__ * a_dim1 + 1], &c__1, &a[l * a_dim1 + 1], &c__1);
i__1 = *n - k + 1;
dswap_(&i__1, &a[i__ + k * a_dim1], lda, &a[l + k * a_dim1], lda);
}
noconv = TRUE_;
if (l == 1) {
*ilo = 1;
*ihi = 1;
return 0;
}
--l;
}
}
}
noconv = TRUE_;
while (noconv) {
noconv = FALSE_;
i__1 = l;
for (j = k; j <= i__1; ++j) {
canswap = TRUE_;
i__2 = l;
for (i__ = k; i__ <= i__2; ++i__) {
if (i__ != j && a[i__ + j * a_dim1] != 0.) {
canswap = FALSE_;
goto L200;
}
}
L200:
if (canswap) {
scale[k] = (doublereal)j;
if (j != k) {
dswap_(&l, &a[j * a_dim1 + 1], &c__1, &a[k * a_dim1 + 1], &c__1);
i__2 = *n - k + 1;
dswap_(&i__2, &a[j + k * a_dim1], lda, &a[k + k * a_dim1], lda);
}
noconv = TRUE_;
++k;
}
}
} }
m = k;
iexc = 2;
goto L20;
L110:;
} }
L120:
i__1 = l; i__1 = l;
for (i__ = k; i__ <= i__1; ++i__) { for (i__ = k; i__ <= i__1; ++i__) {
scale[i__] = 1.; scale[i__] = 1.;
} }
if (lsame_(job, (char *)"P", (ftnlen)1, (ftnlen)1)) { if (lsame_(job, (char *)"P", (ftnlen)1, (ftnlen)1)) {
goto L210; *ilo = k;
*ihi = l;
return 0;
} }
sfmin1 = dlamch_((char *)"S", (ftnlen)1) / dlamch_((char *)"P", (ftnlen)1); sfmin1 = dlamch_((char *)"S", (ftnlen)1) / dlamch_((char *)"P", (ftnlen)1);
sfmax1 = 1. / sfmin1; sfmax1 = 1. / sfmin1;
sfmin2 = sfmin1 * 2.; sfmin2 = sfmin1 * 2.;
sfmax2 = 1. / sfmin2; sfmax2 = 1. / sfmin2;
L140: noconv = TRUE_;
while (noconv) {
noconv = FALSE_; noconv = FALSE_;
i__1 = l; i__1 = l;
for (i__ = k; i__ <= i__1; ++i__) { for (i__ = k; i__ <= i__1; ++i__) {
@ -142,57 +142,51 @@ L140:
ira = idamax_(&i__2, &a[i__ + k * a_dim1], lda); ira = idamax_(&i__2, &a[i__ + k * a_dim1], lda);
ra = (d__1 = a[i__ + (ira + k - 1) * a_dim1], abs(d__1)); ra = (d__1 = a[i__ + (ira + k - 1) * a_dim1], abs(d__1));
if (c__ == 0. || r__ == 0.) { if (c__ == 0. || r__ == 0.) {
goto L200; goto L300;
} }
g = r__ / 2.; d__1 = c__ + ca + r__ + ra;
f = 1.;
s = c__ + r__;
L160:
d__1 = max(f, c__);
d__2 = min(r__, g);
if (c__ >= g || max(d__1, ca) >= sfmax2 || min(d__2, ra) <= sfmin2) {
goto L170;
}
d__1 = c__ + f + ca + r__ + g + ra;
if (disnan_(&d__1)) { if (disnan_(&d__1)) {
*info = -3; *info = -3;
i__2 = -(*info); i__2 = -(*info);
xerbla_((char *)"DGEBAL", &i__2, (ftnlen)6); xerbla_((char *)"DGEBAL", &i__2, (ftnlen)6);
return 0; return 0;
} }
g = r__ / 2.;
f = 1.;
s = c__ + r__;
for (;;) {
d__1 = max(f, c__);
d__2 = min(r__, g);
if (!(c__ < g && max(d__1, ca) < sfmax2 && min(d__2, ra) > sfmin2)) break;
f *= 2.; f *= 2.;
c__ *= 2.; c__ *= 2.;
ca *= 2.; ca *= 2.;
r__ /= 2.; r__ /= 2.;
g /= 2.; g /= 2.;
ra /= 2.; ra /= 2.;
goto L160;
L170:
g = c__ / 2.;
L180:
d__1 = min(f, c__), d__1 = min(d__1, g);
if (g < r__ || max(r__, ra) >= sfmax2 || min(d__1, ca) <= sfmin2) {
goto L190;
} }
g = c__ / 2.;
for (;;) {
d__1 = min(f, c__), d__1 = min(d__1, g);
if (!(g >= r__ && max(r__, ra) < sfmax2 && min(d__1, ca) > sfmin2)) break;
f /= 2.; f /= 2.;
c__ /= 2.; c__ /= 2.;
g /= 2.; g /= 2.;
ca /= 2.; ca /= 2.;
r__ *= 2.; r__ *= 2.;
ra *= 2.; ra *= 2.;
goto L180; }
L190:
if (c__ + r__ >= s * .95) { if (c__ + r__ >= s * .95) {
goto L200; goto L300;
} }
if (f < 1. && scale[i__] < 1.) { if (f < 1. && scale[i__] < 1.) {
if (f * scale[i__] <= sfmin1) { if (f * scale[i__] <= sfmin1) {
goto L200; goto L300;
} }
} }
if (f > 1. && scale[i__] > 1.) { if (f > 1. && scale[i__] > 1.) {
if (scale[i__] >= sfmax1 / f) { if (scale[i__] >= sfmax1 / f) {
goto L200; goto L300;
} }
} }
g = 1. / f; g = 1. / f;
@ -201,313 +195,13 @@ L140:
i__2 = *n - k + 1; i__2 = *n - k + 1;
dscal_(&i__2, &g, &a[i__ + k * a_dim1], lda); dscal_(&i__2, &g, &a[i__ + k * a_dim1], lda);
dscal_(&l, &f, &a[i__ * a_dim1 + 1], &c__1); dscal_(&l, &f, &a[i__ * a_dim1 + 1], &c__1);
L200:; L300:;
} }
if (noconv) {
goto L140;
} }
L210:
*ilo = k; *ilo = k;
*ihi = l; *ihi = l;
return 0; return 0;
} }
int dgeev_(char *jobvl, char *jobvr, integer *n, doublereal *a, integer *lda, doublereal *wr,
doublereal *wi, doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr,
doublereal *work, integer *lwork, integer *info, ftnlen jobvl_len, ftnlen jobvr_len)
{
integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3;
doublereal d__1, d__2;
double sqrt(doublereal);
integer i__, k;
doublereal r__, cs, sn;
integer ihi;
doublereal scl;
integer ilo;
doublereal dum[1], eps;
integer lwork_trevc__, ibal;
char side[1];
doublereal anrm;
integer ierr, itau;
extern int drot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *,
doublereal *);
integer iwrk, nout;
extern doublereal dnrm2_(integer *, doublereal *, integer *);
extern int dscal_(integer *, doublereal *, doublereal *, integer *);
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern doublereal dlapy2_(doublereal *, doublereal *);
extern int dlabad_(doublereal *, doublereal *),
dgebak_(char *, char *, integer *, integer *, integer *, doublereal *, integer *,
doublereal *, integer *, integer *, ftnlen, ftnlen),
dgebal_(char *, integer *, doublereal *, integer *, integer *, integer *, doublereal *,
integer *, ftnlen);
logical scalea;
extern doublereal dlamch_(char *, ftnlen);
doublereal cscale;
extern doublereal dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
ftnlen);
extern int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, integer *),
dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *,
doublereal *, integer *, integer *, ftnlen);
extern integer idamax_(integer *, doublereal *, integer *);
extern int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
integer *, ftnlen),
dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *),
xerbla_(char *, integer *, ftnlen);
logical select[1];
extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
ftnlen, ftnlen);
doublereal bignum;
extern int dorghr_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, integer *),
dhseqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *,
doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *,
integer *, ftnlen, ftnlen);
integer minwrk, maxwrk;
logical wantvl;
doublereal smlnum;
integer hswork;
logical lquery, wantvr;
extern int dtrevc3_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *,
integer *, doublereal *, integer *, integer *, integer *, doublereal *,
integer *, integer *, ftnlen, ftnlen);
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--wr;
--wi;
vl_dim1 = *ldvl;
vl_offset = 1 + vl_dim1;
vl -= vl_offset;
vr_dim1 = *ldvr;
vr_offset = 1 + vr_dim1;
vr -= vr_offset;
--work;
*info = 0;
lquery = *lwork == -1;
wantvl = lsame_(jobvl, (char *)"V", (ftnlen)1, (ftnlen)1);
wantvr = lsame_(jobvr, (char *)"V", (ftnlen)1, (ftnlen)1);
if (!wantvl && !lsame_(jobvl, (char *)"N", (ftnlen)1, (ftnlen)1)) {
*info = -1;
} else if (!wantvr && !lsame_(jobvr, (char *)"N", (ftnlen)1, (ftnlen)1)) {
*info = -2;
} else if (*n < 0) {
*info = -3;
} else if (*lda < max(1, *n)) {
*info = -5;
} else if (*ldvl < 1 || wantvl && *ldvl < *n) {
*info = -9;
} else if (*ldvr < 1 || wantvr && *ldvr < *n) {
*info = -11;
}
if (*info == 0) {
if (*n == 0) {
minwrk = 1;
maxwrk = 1;
} else {
maxwrk = (*n << 1) +
*n * ilaenv_(&c__1, (char *)"DGEHRD", (char *)" ", n, &c__1, n, &c__0, (ftnlen)6, (ftnlen)1);
if (wantvl) {
minwrk = *n << 2;
i__1 = maxwrk,
i__2 = (*n << 1) + (*n - 1) * ilaenv_(&c__1, (char *)"DORGHR", (char *)" ", n, &c__1, n, &c_n1,
(ftnlen)6, (ftnlen)1);
maxwrk = max(i__1, i__2);
dhseqr_((char *)"S", (char *)"V", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[1], &vl[vl_offset],
ldvl, &work[1], &c_n1, info, (ftnlen)1, (ftnlen)1);
hswork = (integer)work[1];
i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1, i__2), i__2 = *n + hswork;
maxwrk = max(i__1, i__2);
dtrevc3_((char *)"L", (char *)"B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl,
&vr[vr_offset], ldvr, n, &nout, &work[1], &c_n1, &ierr, (ftnlen)1,
(ftnlen)1);
lwork_trevc__ = (integer)work[1];
i__1 = maxwrk, i__2 = *n + lwork_trevc__;
maxwrk = max(i__1, i__2);
i__1 = maxwrk, i__2 = *n << 2;
maxwrk = max(i__1, i__2);
} else if (wantvr) {
minwrk = *n << 2;
i__1 = maxwrk,
i__2 = (*n << 1) + (*n - 1) * ilaenv_(&c__1, (char *)"DORGHR", (char *)" ", n, &c__1, n, &c_n1,
(ftnlen)6, (ftnlen)1);
maxwrk = max(i__1, i__2);
dhseqr_((char *)"S", (char *)"V", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset],
ldvr, &work[1], &c_n1, info, (ftnlen)1, (ftnlen)1);
hswork = (integer)work[1];
i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1, i__2), i__2 = *n + hswork;
maxwrk = max(i__1, i__2);
dtrevc3_((char *)"R", (char *)"B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl,
&vr[vr_offset], ldvr, n, &nout, &work[1], &c_n1, &ierr, (ftnlen)1,
(ftnlen)1);
lwork_trevc__ = (integer)work[1];
i__1 = maxwrk, i__2 = *n + lwork_trevc__;
maxwrk = max(i__1, i__2);
i__1 = maxwrk, i__2 = *n << 2;
maxwrk = max(i__1, i__2);
} else {
minwrk = *n * 3;
dhseqr_((char *)"E", (char *)"N", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset],
ldvr, &work[1], &c_n1, info, (ftnlen)1, (ftnlen)1);
hswork = (integer)work[1];
i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1, i__2), i__2 = *n + hswork;
maxwrk = max(i__1, i__2);
}
maxwrk = max(maxwrk, minwrk);
}
work[1] = (doublereal)maxwrk;
if (*lwork < minwrk && !lquery) {
*info = -13;
}
}
if (*info != 0) {
i__1 = -(*info);
xerbla_((char *)"DGEEV ", &i__1, (ftnlen)6);
return 0;
} else if (lquery) {
return 0;
}
if (*n == 0) {
return 0;
}
eps = dlamch_((char *)"P", (ftnlen)1);
smlnum = dlamch_((char *)"S", (ftnlen)1);
bignum = 1. / smlnum;
dlabad_(&smlnum, &bignum);
smlnum = sqrt(smlnum) / eps;
bignum = 1. / smlnum;
anrm = dlange_((char *)"M", n, n, &a[a_offset], lda, dum, (ftnlen)1);
scalea = FALSE_;
if (anrm > 0. && anrm < smlnum) {
scalea = TRUE_;
cscale = smlnum;
} else if (anrm > bignum) {
scalea = TRUE_;
cscale = bignum;
}
if (scalea) {
dlascl_((char *)"G", &c__0, &c__0, &anrm, &cscale, n, n, &a[a_offset], lda, &ierr, (ftnlen)1);
}
ibal = 1;
dgebal_((char *)"B", n, &a[a_offset], lda, &ilo, &ihi, &work[ibal], &ierr, (ftnlen)1);
itau = ibal + *n;
iwrk = itau + *n;
i__1 = *lwork - iwrk + 1;
dgehrd_(n, &ilo, &ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1, &ierr);
if (wantvl) {
*(unsigned char *)side = 'L';
dlacpy_((char *)"L", n, n, &a[a_offset], lda, &vl[vl_offset], ldvl, (ftnlen)1);
i__1 = *lwork - iwrk + 1;
dorghr_(n, &ilo, &ihi, &vl[vl_offset], ldvl, &work[itau], &work[iwrk], &i__1, &ierr);
iwrk = itau;
i__1 = *lwork - iwrk + 1;
dhseqr_((char *)"S", (char *)"V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &vl[vl_offset], ldvl,
&work[iwrk], &i__1, info, (ftnlen)1, (ftnlen)1);
if (wantvr) {
*(unsigned char *)side = 'B';
dlacpy_((char *)"F", n, n, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr, (ftnlen)1);
}
} else if (wantvr) {
*(unsigned char *)side = 'R';
dlacpy_((char *)"L", n, n, &a[a_offset], lda, &vr[vr_offset], ldvr, (ftnlen)1);
i__1 = *lwork - iwrk + 1;
dorghr_(n, &ilo, &ihi, &vr[vr_offset], ldvr, &work[itau], &work[iwrk], &i__1, &ierr);
iwrk = itau;
i__1 = *lwork - iwrk + 1;
dhseqr_((char *)"S", (char *)"V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset], ldvr,
&work[iwrk], &i__1, info, (ftnlen)1, (ftnlen)1);
} else {
iwrk = itau;
i__1 = *lwork - iwrk + 1;
dhseqr_((char *)"E", (char *)"N", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset], ldvr,
&work[iwrk], &i__1, info, (ftnlen)1, (ftnlen)1);
}
if (*info != 0) {
goto L50;
}
if (wantvl || wantvr) {
i__1 = *lwork - iwrk + 1;
dtrevc3_(side, (char *)"B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl, &vr[vr_offset],
ldvr, n, &nout, &work[iwrk], &i__1, &ierr, (ftnlen)1, (ftnlen)1);
}
if (wantvl) {
dgebak_((char *)"B", (char *)"L", n, &ilo, &ihi, &work[ibal], n, &vl[vl_offset], ldvl, &ierr, (ftnlen)1,
(ftnlen)1);
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
if (wi[i__] == 0.) {
scl = 1. / dnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1);
dscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1);
} else if (wi[i__] > 0.) {
d__1 = dnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1);
d__2 = dnrm2_(n, &vl[(i__ + 1) * vl_dim1 + 1], &c__1);
scl = 1. / dlapy2_(&d__1, &d__2);
dscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1);
dscal_(n, &scl, &vl[(i__ + 1) * vl_dim1 + 1], &c__1);
i__2 = *n;
for (k = 1; k <= i__2; ++k) {
d__1 = vl[k + i__ * vl_dim1];
d__2 = vl[k + (i__ + 1) * vl_dim1];
work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2;
}
k = idamax_(n, &work[iwrk], &c__1);
dlartg_(&vl[k + i__ * vl_dim1], &vl[k + (i__ + 1) * vl_dim1], &cs, &sn, &r__);
drot_(n, &vl[i__ * vl_dim1 + 1], &c__1, &vl[(i__ + 1) * vl_dim1 + 1], &c__1, &cs,
&sn);
vl[k + (i__ + 1) * vl_dim1] = 0.;
}
}
}
if (wantvr) {
dgebak_((char *)"B", (char *)"R", n, &ilo, &ihi, &work[ibal], n, &vr[vr_offset], ldvr, &ierr, (ftnlen)1,
(ftnlen)1);
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
if (wi[i__] == 0.) {
scl = 1. / dnrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1);
dscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1);
} else if (wi[i__] > 0.) {
d__1 = dnrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1);
d__2 = dnrm2_(n, &vr[(i__ + 1) * vr_dim1 + 1], &c__1);
scl = 1. / dlapy2_(&d__1, &d__2);
dscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1);
dscal_(n, &scl, &vr[(i__ + 1) * vr_dim1 + 1], &c__1);
i__2 = *n;
for (k = 1; k <= i__2; ++k) {
d__1 = vr[k + i__ * vr_dim1];
d__2 = vr[k + (i__ + 1) * vr_dim1];
work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2;
}
k = idamax_(n, &work[iwrk], &c__1);
dlartg_(&vr[k + i__ * vr_dim1], &vr[k + (i__ + 1) * vr_dim1], &cs, &sn, &r__);
drot_(n, &vr[i__ * vr_dim1 + 1], &c__1, &vr[(i__ + 1) * vr_dim1 + 1], &c__1, &cs,
&sn);
vr[k + (i__ + 1) * vr_dim1] = 0.;
}
}
}
L50:
if (scalea) {
i__1 = *n - *info;
i__3 = *n - *info;
i__2 = max(i__3, 1);
dlascl_((char *)"G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[*info + 1], &i__2, &ierr,
(ftnlen)1);
i__1 = *n - *info;
i__3 = *n - *info;
i__2 = max(i__3, 1);
dlascl_((char *)"G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[*info + 1], &i__2, &ierr,
(ftnlen)1);
if (*info > 0) {
i__1 = ilo - 1;
dlascl_((char *)"G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[1], n, &ierr, (ftnlen)1);
i__1 = ilo - 1;
dlascl_((char *)"G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[1], n, &ierr, (ftnlen)1);
}
}
work[1] = (doublereal)maxwrk;
return 0;
}
#ifdef __cplusplus #ifdef __cplusplus
} }
#endif #endif

32
lib/linalg/dgebd2.cpp
View File

@ -8,10 +8,10 @@ int dgebd2_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *d__
{ {
integer a_dim1, a_offset, i__1, i__2, i__3; integer a_dim1, a_offset, i__1, i__2, i__3;
integer i__; integer i__;
extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, extern int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *),
doublereal *, integer *, doublereal *, ftnlen), xerbla_(char *, integer *, ftnlen),
dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), dlarf1f_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *,
xerbla_(char *, integer *, ftnlen); integer *, doublereal *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -41,26 +41,22 @@ int dgebd2_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *d__
dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m) + i__ * a_dim1], &c__1, dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m) + i__ * a_dim1], &c__1,
&tauq[i__]); &tauq[i__]);
d__[i__] = a[i__ + i__ * a_dim1]; d__[i__] = a[i__ + i__ * a_dim1];
a[i__ + i__ * a_dim1] = 1.;
if (i__ < *n) { if (i__ < *n) {
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
i__3 = *n - i__; i__3 = *n - i__;
dlarf_((char *)"Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &c__1, &tauq[i__], dlarf1f_((char *)"L", &i__2, &i__3, &a[i__ + i__ * a_dim1], &c__1, &tauq[i__],
&a[i__ + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)4); &a[i__ + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)1);
} }
a[i__ + i__ * a_dim1] = d__[i__];
if (i__ < *n) { if (i__ < *n) {
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ + 2; i__3 = i__ + 2;
dlarfg_(&i__2, &a[i__ + (i__ + 1) * a_dim1], &a[i__ + min(i__3, *n) * a_dim1], lda, dlarfg_(&i__2, &a[i__ + (i__ + 1) * a_dim1], &a[i__ + min(i__3, *n) * a_dim1], lda,
&taup[i__]); &taup[i__]);
e[i__] = a[i__ + (i__ + 1) * a_dim1]; e[i__] = a[i__ + (i__ + 1) * a_dim1];
a[i__ + (i__ + 1) * a_dim1] = 1.;
i__2 = *m - i__; i__2 = *m - i__;
i__3 = *n - i__; i__3 = *n - i__;
dlarf_((char *)"Right", &i__2, &i__3, &a[i__ + (i__ + 1) * a_dim1], lda, &taup[i__], dlarf1f_((char *)"R", &i__2, &i__3, &a[i__ + (i__ + 1) * a_dim1], lda, &taup[i__],
&a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)5); &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)1);
a[i__ + (i__ + 1) * a_dim1] = e[i__];
} else { } else {
taup[i__] = 0.; taup[i__] = 0.;
} }
@ -73,26 +69,22 @@ int dgebd2_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *d__
dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n) * a_dim1], lda, dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n) * a_dim1], lda,
&taup[i__]); &taup[i__]);
d__[i__] = a[i__ + i__ * a_dim1]; d__[i__] = a[i__ + i__ * a_dim1];
a[i__ + i__ * a_dim1] = 1.;
if (i__ < *m) { if (i__ < *m) {
i__2 = *m - i__; i__2 = *m - i__;
i__3 = *n - i__ + 1; i__3 = *n - i__ + 1;
dlarf_((char *)"Right", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &taup[i__], dlarf1f_((char *)"R", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &taup[i__],
&a[i__ + 1 + i__ * a_dim1], lda, &work[1], (ftnlen)5); &a[i__ + 1 + i__ * a_dim1], lda, &work[1], (ftnlen)1);
} }
a[i__ + i__ * a_dim1] = d__[i__];
if (i__ < *m) { if (i__ < *m) {
i__2 = *m - i__; i__2 = *m - i__;
i__3 = i__ + 2; i__3 = i__ + 2;
dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *m) + i__ * a_dim1], &c__1, dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *m) + i__ * a_dim1], &c__1,
&tauq[i__]); &tauq[i__]);
e[i__] = a[i__ + 1 + i__ * a_dim1]; e[i__] = a[i__ + 1 + i__ * a_dim1];
a[i__ + 1 + i__ * a_dim1] = 1.;
i__2 = *m - i__; i__2 = *m - i__;
i__3 = *n - i__; i__3 = *n - i__;
dlarf_((char *)"Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &c__1, &tauq[i__], dlarf1f_((char *)"L", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &c__1, &tauq[i__],
&a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)4); &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)1);
a[i__ + 1 + i__ * a_dim1] = e[i__];
} else { } else {
tauq[i__] = 0.; tauq[i__] = 0.;
} }

27
lib/linalg/dgebrd.cpp
View File

@ -25,7 +25,7 @@ int dgebrd_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *d__
xerbla_(char *, integer *, ftnlen); xerbla_(char *, integer *, ftnlen);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
ftnlen, ftnlen); ftnlen, ftnlen);
integer ldwrkx, ldwrky, lwkopt; integer lwkmin, ldwrkx, ldwrky, lwkopt;
logical lquery; logical lquery;
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
@ -36,9 +36,16 @@ int dgebrd_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *d__
--taup; --taup;
--work; --work;
*info = 0; *info = 0;
minmn = min(*m, *n);
if (minmn == 0) {
lwkmin = 1;
lwkopt = 1;
} else {
lwkmin = max(*m, *n);
i__1 = 1, i__2 = ilaenv_(&c__1, (char *)"DGEBRD", (char *)" ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); i__1 = 1, i__2 = ilaenv_(&c__1, (char *)"DGEBRD", (char *)" ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
nb = max(i__1, i__2); nb = max(i__1, i__2);
lwkopt = (*m + *n) * nb; lwkopt = (*m + *n) * nb;
}
work[1] = (doublereal)lwkopt; work[1] = (doublereal)lwkopt;
lquery = *lwork == -1; lquery = *lwork == -1;
if (*m < 0) { if (*m < 0) {
@ -47,12 +54,9 @@ int dgebrd_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *d__
*info = -2; *info = -2;
} else if (*lda < max(1, *m)) { } else if (*lda < max(1, *m)) {
*info = -4; *info = -4;
} else { } else if (*lwork < lwkmin && !lquery) {
i__1 = max(1, *m);
if (*lwork < max(i__1, *n) && !lquery) {
*info = -10; *info = -10;
} }
}
if (*info < 0) { if (*info < 0) {
i__1 = -(*info); i__1 = -(*info);
xerbla_((char *)"DGEBRD", &i__1, (ftnlen)6); xerbla_((char *)"DGEBRD", &i__1, (ftnlen)6);
@ -60,7 +64,6 @@ int dgebrd_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *d__
} else if (lquery) { } else if (lquery) {
return 0; return 0;
} }
minmn = min(*m, *n);
if (minmn == 0) { if (minmn == 0) {
work[1] = 1.; work[1] = 1.;
return 0; return 0;
@ -72,7 +75,7 @@ int dgebrd_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *d__
i__1 = nb, i__2 = ilaenv_(&c__3, (char *)"DGEBRD", (char *)" ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); i__1 = nb, i__2 = ilaenv_(&c__3, (char *)"DGEBRD", (char *)" ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
nx = max(i__1, i__2); nx = max(i__1, i__2);
if (nx < minmn) { if (nx < minmn) {
ws = (*m + *n) * nb; ws = lwkopt;
if (*lwork < ws) { if (*lwork < ws) {
nbmin = ilaenv_(&c__2, (char *)"DGEBRD", (char *)" ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); nbmin = ilaenv_(&c__2, (char *)"DGEBRD", (char *)" ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
if (*lwork >= (*m + *n) * nbmin) { if (*lwork >= (*m + *n) * nbmin) {
@ -95,14 +98,14 @@ int dgebrd_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *d__
&taup[i__], &work[1], &ldwrkx, &work[ldwrkx * nb + 1], &ldwrky); &taup[i__], &work[1], &ldwrkx, &work[ldwrkx * nb + 1], &ldwrky);
i__3 = *m - i__ - nb + 1; i__3 = *m - i__ - nb + 1;
i__4 = *n - i__ - nb + 1; i__4 = *n - i__ - nb + 1;
dgemm_((char *)"No transpose", (char *)"Transpose", &i__3, &i__4, &nb, &c_b21, &a[i__ + nb + i__ * a_dim1], dgemm_((char *)"N", (char *)"T", &i__3, &i__4, &nb, &c_b21, &a[i__ + nb + i__ * a_dim1], lda,
lda, &work[ldwrkx * nb + nb + 1], &ldwrky, &c_b22, &work[ldwrkx * nb + nb + 1], &ldwrky, &c_b22, &a[i__ + nb + (i__ + nb) * a_dim1],
&a[i__ + nb + (i__ + nb) * a_dim1], lda, (ftnlen)12, (ftnlen)9); lda, (ftnlen)1, (ftnlen)1);
i__3 = *m - i__ - nb + 1; i__3 = *m - i__ - nb + 1;
i__4 = *n - i__ - nb + 1; i__4 = *n - i__ - nb + 1;
dgemm_((char *)"No transpose", (char *)"No transpose", &i__3, &i__4, &nb, &c_b21, &work[nb + 1], &ldwrkx, dgemm_((char *)"N", (char *)"N", &i__3, &i__4, &nb, &c_b21, &work[nb + 1], &ldwrkx,
&a[i__ + (i__ + nb) * a_dim1], lda, &c_b22, &a[i__ + nb + (i__ + nb) * a_dim1], lda, &a[i__ + (i__ + nb) * a_dim1], lda, &c_b22, &a[i__ + nb + (i__ + nb) * a_dim1], lda,
(ftnlen)12, (ftnlen)12); (ftnlen)1, (ftnlen)1);
if (*m >= *n) { if (*m >= *n) {
i__3 = i__ + nb - 1; i__3 = i__ + nb - 1;
for (j = i__; j <= i__3; ++j) { for (j = i__; j <= i__3; ++j) {

16
lib/linalg/dgecon.cpp
View File

@ -78,15 +78,15 @@ L10:
dlacn2_(n, &work[*n + 1], &work[1], &iwork[1], &ainvnm, &kase, isave); dlacn2_(n, &work[*n + 1], &work[1], &iwork[1], &ainvnm, &kase, isave);
if (kase != 0) { if (kase != 0) {
if (kase == kase1) { if (kase == kase1) {
dlatrs_((char *)"Lower", (char *)"No transpose", (char *)"Unit", normin, n, &a[a_offset], lda, &work[1], &sl, dlatrs_((char *)"L", (char *)"N", (char *)"U", normin, n, &a[a_offset], lda, &work[1], &sl,
&work[(*n << 1) + 1], info, (ftnlen)5, (ftnlen)12, (ftnlen)4, (ftnlen)1); &work[(*n << 1) + 1], info, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
dlatrs_((char *)"Upper", (char *)"No transpose", (char *)"Non-unit", normin, n, &a[a_offset], lda, &work[1], dlatrs_((char *)"U", (char *)"N", (char *)"N", normin, n, &a[a_offset], lda, &work[1], &su, &work[*n * 3 + 1],
&su, &work[*n * 3 + 1], info, (ftnlen)5, (ftnlen)12, (ftnlen)8, (ftnlen)1); info, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} else { } else {
dlatrs_((char *)"Upper", (char *)"Transpose", (char *)"Non-unit", normin, n, &a[a_offset], lda, &work[1], &su, dlatrs_((char *)"U", (char *)"T", (char *)"N", normin, n, &a[a_offset], lda, &work[1], &su, &work[*n * 3 + 1],
&work[*n * 3 + 1], info, (ftnlen)5, (ftnlen)9, (ftnlen)8, (ftnlen)1); info, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
dlatrs_((char *)"Lower", (char *)"Transpose", (char *)"Unit", normin, n, &a[a_offset], lda, &work[1], &sl, dlatrs_((char *)"L", (char *)"T", (char *)"U", normin, n, &a[a_offset], lda, &work[1], &sl,
&work[(*n << 1) + 1], info, (ftnlen)5, (ftnlen)9, (ftnlen)4, (ftnlen)1); &work[(*n << 1) + 1], info, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
scale = sl * su; scale = sl * su;
*(unsigned char *)normin = 'Y'; *(unsigned char *)normin = 'Y';

20
lib/linalg/dgehd2.cpp
View File

@ -8,11 +8,10 @@ int dgehd2_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda,
{ {
integer a_dim1, a_offset, i__1, i__2, i__3; integer a_dim1, a_offset, i__1, i__2, i__3;
integer i__; integer i__;
doublereal aii; extern int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *),
extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, xerbla_(char *, integer *, ftnlen),
doublereal *, integer *, doublereal *, ftnlen), dlarf1f_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *,
dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), integer *, doublereal *, ftnlen);
xerbla_(char *, integer *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -39,16 +38,13 @@ int dgehd2_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda,
i__3 = i__ + 2; i__3 = i__ + 2;
dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *n) + i__ * a_dim1], &c__1, dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *n) + i__ * a_dim1], &c__1,
&tau[i__]); &tau[i__]);
aii = a[i__ + 1 + i__ * a_dim1];
a[i__ + 1 + i__ * a_dim1] = 1.;
i__2 = *ihi - i__; i__2 = *ihi - i__;
dlarf_((char *)"Right", ihi, &i__2, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[i__], dlarf1f_((char *)"R", ihi, &i__2, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[i__],
&a[(i__ + 1) * a_dim1 + 1], lda, &work[1], (ftnlen)5); &a[(i__ + 1) * a_dim1 + 1], lda, &work[1], (ftnlen)1);
i__2 = *ihi - i__; i__2 = *ihi - i__;
i__3 = *n - i__; i__3 = *n - i__;
dlarf_((char *)"Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[i__], dlarf1f_((char *)"L", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[i__],
&a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)4); &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)1);
a[i__ + 1 + i__ * a_dim1] = aii;
} }
return 0; return 0;
} }

27
lib/linalg/dgehrd.cpp
View File

@ -54,10 +54,16 @@ int dgehrd_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda,
} else if (*lwork < max(1, *n) && !lquery) { } else if (*lwork < max(1, *n) && !lquery) {
*info = -8; *info = -8;
} }
nh = *ihi - *ilo + 1;
if (*info == 0) { if (*info == 0) {
i__1 = 64, i__2 = ilaenv_(&c__1, (char *)"DGEHRD", (char *)" ", n, ilo, ihi, &c_n1, (ftnlen)6, (ftnlen)1); if (nh <= 1) {
lwkopt = 1;
} else {
i__1 = 64,
i__2 = ilaenv_(&c__1, (char *)"DGEHRD", (char *)" ", n, ilo, ihi, &c_n1, (ftnlen)6, (ftnlen)1);
nb = min(i__1, i__2); nb = min(i__1, i__2);
lwkopt = *n * nb + 4160; lwkopt = *n * nb + 4160;
}
work[1] = (doublereal)lwkopt; work[1] = (doublereal)lwkopt;
} }
if (*info != 0) { if (*info != 0) {
@ -75,7 +81,6 @@ int dgehrd_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda,
for (i__ = max(1, *ihi); i__ <= i__1; ++i__) { for (i__ = max(1, *ihi); i__ <= i__1; ++i__) {
tau[i__] = 0.; tau[i__] = 0.;
} }
nh = *ihi - *ilo + 1;
if (nh <= 1) { if (nh <= 1) {
work[1] = 1.; work[1] = 1.;
return 0; return 0;
@ -87,7 +92,7 @@ int dgehrd_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda,
i__1 = nb, i__2 = ilaenv_(&c__3, (char *)"DGEHRD", (char *)" ", n, ilo, ihi, &c_n1, (ftnlen)6, (ftnlen)1); i__1 = nb, i__2 = ilaenv_(&c__3, (char *)"DGEHRD", (char *)" ", n, ilo, ihi, &c_n1, (ftnlen)6, (ftnlen)1);
nx = max(i__1, i__2); nx = max(i__1, i__2);
if (nx < nh) { if (nx < nh) {
if (*lwork < *n * nb + 4160) { if (*lwork < lwkopt) {
i__1 = 2, i__1 = 2,
i__2 = ilaenv_(&c__2, (char *)"DGEHRD", (char *)" ", n, ilo, ihi, &c_n1, (ftnlen)6, (ftnlen)1); i__2 = ilaenv_(&c__2, (char *)"DGEHRD", (char *)" ", n, ilo, ihi, &c_n1, (ftnlen)6, (ftnlen)1);
nbmin = max(i__1, i__2); nbmin = max(i__1, i__2);
@ -114,14 +119,13 @@ int dgehrd_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda,
ei = a[i__ + ib + (i__ + ib - 1) * a_dim1]; ei = a[i__ + ib + (i__ + ib - 1) * a_dim1];
a[i__ + ib + (i__ + ib - 1) * a_dim1] = 1.; a[i__ + ib + (i__ + ib - 1) * a_dim1] = 1.;
i__3 = *ihi - i__ - ib + 1; i__3 = *ihi - i__ - ib + 1;
dgemm_((char *)"No transpose", (char *)"Transpose", ihi, &i__3, &ib, &c_b25, &work[1], &ldwork, dgemm_((char *)"N", (char *)"T", ihi, &i__3, &ib, &c_b25, &work[1], &ldwork,
&a[i__ + ib + i__ * a_dim1], lda, &c_b26, &a[(i__ + ib) * a_dim1 + 1], lda, &a[i__ + ib + i__ * a_dim1], lda, &c_b26, &a[(i__ + ib) * a_dim1 + 1], lda,
(ftnlen)12, (ftnlen)9); (ftnlen)1, (ftnlen)1);
a[i__ + ib + (i__ + ib - 1) * a_dim1] = ei; a[i__ + ib + (i__ + ib - 1) * a_dim1] = ei;
i__3 = ib - 1; i__3 = ib - 1;
dtrmm_((char *)"Right", (char *)"Lower", (char *)"Transpose", (char *)"Unit", &i__, &i__3, &c_b26, dtrmm_((char *)"R", (char *)"L", (char *)"T", (char *)"U", &i__, &i__3, &c_b26, &a[i__ + 1 + i__ * a_dim1], lda,
&a[i__ + 1 + i__ * a_dim1], lda, &work[1], &ldwork, (ftnlen)5, (ftnlen)5, &work[1], &ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)9, (ftnlen)4);
i__3 = ib - 2; i__3 = ib - 2;
for (j = 0; j <= i__3; ++j) { for (j = 0; j <= i__3; ++j) {
daxpy_(&i__, &c_b25, &work[ldwork * j + 1], &c__1, &a[(i__ + j + 1) * a_dim1 + 1], daxpy_(&i__, &c_b25, &work[ldwork * j + 1], &c__1, &a[(i__ + j + 1) * a_dim1 + 1],
@ -129,10 +133,9 @@ int dgehrd_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda,
} }
i__3 = *ihi - i__; i__3 = *ihi - i__;
i__4 = *n - i__ - ib + 1; i__4 = *n - i__ - ib + 1;
dlarfb_((char *)"Left", (char *)"Transpose", (char *)"Forward", (char *)"Columnwise", &i__3, &i__4, &ib, dlarfb_((char *)"L", (char *)"T", (char *)"F", (char *)"C", &i__3, &i__4, &ib, &a[i__ + 1 + i__ * a_dim1], lda,
&a[i__ + 1 + i__ * a_dim1], lda, &work[iwt], &c__65, &work[iwt], &c__65, &a[i__ + 1 + (i__ + ib) * a_dim1], lda, &work[1], &ldwork,
&a[i__ + 1 + (i__ + ib) * a_dim1], lda, &work[1], &ldwork, (ftnlen)4, (ftnlen)9, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)7, (ftnlen)10);
} }
} }
dgehd2_(n, &i__, ihi, &a[a_offset], lda, &tau[1], &work[1], &iinfo); dgehd2_(n, &i__, ihi, &a[a_offset], lda, &tau[1], &work[1], &iinfo);

16
lib/linalg/dgelq2.cpp
View File

@ -7,11 +7,10 @@ int dgelq2_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau
{ {
integer a_dim1, a_offset, i__1, i__2, i__3; integer a_dim1, a_offset, i__1, i__2, i__3;
integer i__, k; integer i__, k;
doublereal aii; extern int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *),
extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, xerbla_(char *, integer *, ftnlen),
doublereal *, integer *, doublereal *, ftnlen), dlarf1f_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *,
dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), integer *, doublereal *, ftnlen);
xerbla_(char *, integer *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -37,13 +36,10 @@ int dgelq2_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau
i__3 = i__ + 1; i__3 = i__ + 1;
dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n) * a_dim1], lda, &tau[i__]); dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n) * a_dim1], lda, &tau[i__]);
if (i__ < *m) { if (i__ < *m) {
aii = a[i__ + i__ * a_dim1];
a[i__ + i__ * a_dim1] = 1.;
i__2 = *m - i__; i__2 = *m - i__;
i__3 = *n - i__ + 1; i__3 = *n - i__ + 1;
dlarf_((char *)"Right", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], dlarf1f_((char *)"R", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__],
&a[i__ + 1 + i__ * a_dim1], lda, &work[1], (ftnlen)5); &a[i__ + 1 + i__ * a_dim1], lda, &work[1], (ftnlen)1);
a[i__ + i__ * a_dim1] = aii;
} }
} }
return 0; return 0;

24
lib/linalg/dgelqf.cpp
View File

@ -29,9 +29,8 @@ int dgelqf_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau
--tau; --tau;
--work; --work;
*info = 0; *info = 0;
k = min(*m, *n);
nb = ilaenv_(&c__1, (char *)"DGELQF", (char *)" ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); nb = ilaenv_(&c__1, (char *)"DGELQF", (char *)" ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
lwkopt = *m * nb;
work[1] = (doublereal)lwkopt;
lquery = *lwork == -1; lquery = *lwork == -1;
if (*m < 0) { if (*m < 0) {
*info = -1; *info = -1;
@ -39,17 +38,24 @@ int dgelqf_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau
*info = -2; *info = -2;
} else if (*lda < max(1, *m)) { } else if (*lda < max(1, *m)) {
*info = -4; *info = -4;
} else if (*lwork < max(1, *m) && !lquery) { } else if (!lquery) {
if (*lwork <= 0 || *n > 0 && *lwork < max(1, *m)) {
*info = -7; *info = -7;
} }
}
if (*info != 0) { if (*info != 0) {
i__1 = -(*info); i__1 = -(*info);
xerbla_((char *)"DGELQF", &i__1, (ftnlen)6); xerbla_((char *)"DGELQF", &i__1, (ftnlen)6);
return 0; return 0;
} else if (lquery) { } else if (lquery) {
if (k == 0) {
lwkopt = 1;
} else {
lwkopt = *m * nb;
}
work[1] = (doublereal)lwkopt;
return 0; return 0;
} }
k = min(*m, *n);
if (k == 0) { if (k == 0) {
work[1] = 1.; work[1] = 1.;
return 0; return 0;
@ -81,13 +87,13 @@ int dgelqf_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau
dgelq2_(&ib, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo); dgelq2_(&ib, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo);
if (i__ + ib <= *m) { if (i__ + ib <= *m) {
i__3 = *n - i__ + 1; i__3 = *n - i__ + 1;
dlarft_((char *)"Forward", (char *)"Rowwise", &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], dlarft_((char *)"F", (char *)"R", &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1],
&work[1], &ldwork, (ftnlen)7, (ftnlen)7); &ldwork, (ftnlen)1, (ftnlen)1);
i__3 = *m - i__ - ib + 1; i__3 = *m - i__ - ib + 1;
i__4 = *n - i__ + 1; i__4 = *n - i__ + 1;
dlarfb_((char *)"Right", (char *)"No transpose", (char *)"Forward", (char *)"Rowwise", &i__3, &i__4, &ib, dlarfb_((char *)"R", (char *)"N", (char *)"F", (char *)"R", &i__3, &i__4, &ib, &a[i__ + i__ * a_dim1], lda,
&a[i__ + i__ * a_dim1], lda, &work[1], &ldwork, &a[i__ + ib + i__ * a_dim1], &work[1], &ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib + 1], &ldwork,
lda, &work[ib + 1], &ldwork, (ftnlen)5, (ftnlen)12, (ftnlen)7, (ftnlen)7); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
} }
} else { } else {

2
lib/linalg/dgelsd.cpp
View File

@ -86,7 +86,7 @@ int dgelsd_(integer *m, integer *n, integer *nrhs, doublereal *a, integer *lda,
i__1 = (integer)(log((doublereal)minmn / (doublereal)(smlsiz + 1)) / log(2.)) + 1; i__1 = (integer)(log((doublereal)minmn / (doublereal)(smlsiz + 1)) / log(2.)) + 1;
nlvl = max(i__1, 0); nlvl = max(i__1, 0);
if (*info == 0) { if (*info == 0) {
maxwrk = 0; maxwrk = 1;
liwork = minmn * 3 * nlvl + minmn * 11; liwork = minmn * 3 * nlvl + minmn * 11;
mm = *m; mm = *m;
if (*m >= *n && *m >= mnthr) { if (*m >= *n && *m >= mnthr) {

16
lib/linalg/dgeqr2.cpp
View File

@ -8,11 +8,10 @@ int dgeqr2_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau
{ {
integer a_dim1, a_offset, i__1, i__2, i__3; integer a_dim1, a_offset, i__1, i__2, i__3;
integer i__, k; integer i__, k;
doublereal aii; extern int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *),
extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, xerbla_(char *, integer *, ftnlen),
doublereal *, integer *, doublereal *, ftnlen), dlarf1f_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *,
dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), integer *, doublereal *, ftnlen);
xerbla_(char *, integer *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -38,13 +37,10 @@ int dgeqr2_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau
i__3 = i__ + 1; i__3 = i__ + 1;
dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m) + i__ * a_dim1], &c__1, &tau[i__]); dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m) + i__ * a_dim1], &c__1, &tau[i__]);
if (i__ < *n) { if (i__ < *n) {
aii = a[i__ + i__ * a_dim1];
a[i__ + i__ * a_dim1] = 1.;
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
i__3 = *n - i__; i__3 = *n - i__;
dlarf_((char *)"Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &c__1, &tau[i__], dlarf1f_((char *)"L", &i__2, &i__3, &a[i__ + i__ * a_dim1], &c__1, &tau[i__],
&a[i__ + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)4); &a[i__ + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)1);
a[i__ + i__ * a_dim1] = aii;
} }
} }
return 0; return 0;

11
lib/linalg/dgeqrf.cpp
View File

@ -87,14 +87,13 @@ int dgeqrf_(integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau
dgeqr2_(&i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo); dgeqr2_(&i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo);
if (i__ + ib <= *n) { if (i__ + ib <= *n) {
i__3 = *m - i__ + 1; i__3 = *m - i__ + 1;
dlarft_((char *)"Forward", (char *)"Columnwise", &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], dlarft_((char *)"F", (char *)"C", &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1],
&work[1], &ldwork, (ftnlen)7, (ftnlen)10); &ldwork, (ftnlen)1, (ftnlen)1);
i__3 = *m - i__ + 1; i__3 = *m - i__ + 1;
i__4 = *n - i__ - ib + 1; i__4 = *n - i__ - ib + 1;
dlarfb_((char *)"Left", (char *)"Transpose", (char *)"Forward", (char *)"Columnwise", &i__3, &i__4, &ib, dlarfb_((char *)"L", (char *)"T", (char *)"F", (char *)"C", &i__3, &i__4, &ib, &a[i__ + i__ * a_dim1], lda,
&a[i__ + i__ * a_dim1], lda, &work[1], &ldwork, &work[1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &work[ib + 1],
&a[i__ + (i__ + ib) * a_dim1], lda, &work[ib + 1], &ldwork, (ftnlen)4, &ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)9, (ftnlen)7, (ftnlen)10);
} }
} }
} else { } else {

10
lib/linalg/dgesdd.cpp
View File

@ -49,6 +49,7 @@ int dgesdd_(char *jobz, integer *m, integer *n, doublereal *a, integer *lda, dou
xerbla_(char *, integer *, ftnlen), xerbla_(char *, integer *, ftnlen),
dorgbr_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, dorgbr_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, integer *, ftnlen); doublereal *, integer *, integer *, ftnlen);
extern logical disnan_(doublereal *);
doublereal bignum; doublereal bignum;
extern int dormbr_(char *, char *, char *, integer *, integer *, integer *, doublereal *, extern int dormbr_(char *, char *, char *, integer *, integer *, integer *, doublereal *,
integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *,
@ -60,6 +61,7 @@ int dgesdd_(char *jobz, integer *m, integer *n, doublereal *a, integer *lda, dou
integer ldwrkl, ldwrkr, minwrk, ldwrku, maxwrk, ldwkvt; integer ldwrkl, ldwrkr, minwrk, ldwrku, maxwrk, ldwkvt;
doublereal smlnum; doublereal smlnum;
logical wntqas, lquery; logical wntqas, lquery;
extern doublereal droundup_lwork__(integer *);
integer lwork_dgebrd_mm__, lwork_dgebrd_mn__, lwork_dgebrd_nn__, lwork_dgelqf_mn__, integer lwork_dgebrd_mm__, lwork_dgebrd_mn__, lwork_dgebrd_nn__, lwork_dgelqf_mn__,
lwork_dgeqrf_mn__; lwork_dgeqrf_mn__;
a_dim1 = *lda; a_dim1 = *lda;
@ -335,7 +337,7 @@ int dgesdd_(char *jobz, integer *m, integer *n, doublereal *a, integer *lda, dou
} }
} }
maxwrk = max(maxwrk, minwrk); maxwrk = max(maxwrk, minwrk);
work[1] = (doublereal)maxwrk; work[1] = droundup_lwork__(&maxwrk);
if (*lwork < minwrk && !lquery) { if (*lwork < minwrk && !lquery) {
*info = -12; *info = -12;
} }
@ -354,6 +356,10 @@ int dgesdd_(char *jobz, integer *m, integer *n, doublereal *a, integer *lda, dou
smlnum = sqrt(dlamch_((char *)"S", (ftnlen)1)) / eps; smlnum = sqrt(dlamch_((char *)"S", (ftnlen)1)) / eps;
bignum = 1. / smlnum; bignum = 1. / smlnum;
anrm = dlange_((char *)"M", m, n, &a[a_offset], lda, dum, (ftnlen)1); anrm = dlange_((char *)"M", m, n, &a[a_offset], lda, dum, (ftnlen)1);
if (disnan_(&anrm)) {
*info = -4;
return 0;
}
iscl = 0; iscl = 0;
if (anrm > 0. && anrm < smlnum) { if (anrm > 0. && anrm < smlnum) {
iscl = 1; iscl = 1;
@ -780,7 +786,7 @@ int dgesdd_(char *jobz, integer *m, integer *n, doublereal *a, integer *lda, dou
(ftnlen)1); (ftnlen)1);
} }
} }
work[1] = (doublereal)maxwrk; work[1] = droundup_lwork__(&maxwrk);
return 0; return 0;
} }
#ifdef __cplusplus #ifdef __cplusplus

3
lib/linalg/dgesv.cpp
View File

@ -34,8 +34,7 @@ int dgesv_(integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv
} }
dgetrf_(n, n, &a[a_offset], lda, &ipiv[1], info); dgetrf_(n, n, &a[a_offset], lda, &ipiv[1], info);
if (*info == 0) { if (*info == 0) {
dgetrs_((char *)"No transpose", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[b_offset], ldb, info, dgetrs_((char *)"N", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[b_offset], ldb, info, (ftnlen)1);
(ftnlen)12);
} }
return 0; return 0;
} }

11
lib/linalg/dgetrf.cpp
View File

@ -70,15 +70,14 @@ int dgetrf_(integer *m, integer *n, doublereal *a, integer *lda, integer *ipiv,
i__4 = j + jb - 1; i__4 = j + jb - 1;
dlaswp_(&i__3, &a[(j + jb) * a_dim1 + 1], lda, &j, &i__4, &ipiv[1], &c__1); dlaswp_(&i__3, &a[(j + jb) * a_dim1 + 1], lda, &j, &i__4, &ipiv[1], &c__1);
i__3 = *n - j - jb + 1; i__3 = *n - j - jb + 1;
dtrsm_((char *)"Left", (char *)"Lower", (char *)"No transpose", (char *)"Unit", &jb, &i__3, &c_b16, dtrsm_((char *)"L", (char *)"L", (char *)"N", (char *)"U", &jb, &i__3, &c_b16, &a[j + j * a_dim1], lda,
&a[j + j * a_dim1], lda, &a[j + (j + jb) * a_dim1], lda, (ftnlen)4, &a[j + (j + jb) * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12, (ftnlen)4);
if (j + jb <= *m) { if (j + jb <= *m) {
i__3 = *m - j - jb + 1; i__3 = *m - j - jb + 1;
i__4 = *n - j - jb + 1; i__4 = *n - j - jb + 1;
dgemm_((char *)"No transpose", (char *)"No transpose", &i__3, &i__4, &jb, &c_b19, dgemm_((char *)"N", (char *)"N", &i__3, &i__4, &jb, &c_b19, &a[j + jb + j * a_dim1], lda,
&a[j + jb + j * a_dim1], lda, &a[j + (j + jb) * a_dim1], lda, &c_b16, &a[j + (j + jb) * a_dim1], lda, &c_b16, &a[j + jb + (j + jb) * a_dim1],
&a[j + jb + (j + jb) * a_dim1], lda, (ftnlen)12, (ftnlen)12); lda, (ftnlen)1, (ftnlen)1);
} }
} }
} }

19
lib/linalg/dgetri.cpp
View File

@ -36,7 +36,8 @@ int dgetri_(integer *n, doublereal *a, integer *lda, integer *ipiv, doublereal *
--work; --work;
*info = 0; *info = 0;
nb = ilaenv_(&c__1, (char *)"DGETRI", (char *)" ", n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); nb = ilaenv_(&c__1, (char *)"DGETRI", (char *)" ", n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
lwkopt = *n * nb; i__1 = 1, i__2 = *n * nb;
lwkopt = max(i__1, i__2);
work[1] = (doublereal)lwkopt; work[1] = (doublereal)lwkopt;
lquery = *lwork == -1; lquery = *lwork == -1;
if (*n < 0) { if (*n < 0) {
@ -56,7 +57,7 @@ int dgetri_(integer *n, doublereal *a, integer *lda, integer *ipiv, doublereal *
if (*n == 0) { if (*n == 0) {
return 0; return 0;
} }
dtrtri_((char *)"Upper", (char *)"Non-unit", n, &a[a_offset], lda, info, (ftnlen)5, (ftnlen)8); dtrtri_((char *)"U", (char *)"N", n, &a[a_offset], lda, info, (ftnlen)1, (ftnlen)1);
if (*info > 0) { if (*info > 0) {
return 0; return 0;
} }
@ -83,8 +84,8 @@ int dgetri_(integer *n, doublereal *a, integer *lda, integer *ipiv, doublereal *
} }
if (j < *n) { if (j < *n) {
i__1 = *n - j; i__1 = *n - j;
dgemv_((char *)"No transpose", n, &i__1, &c_b20, &a[(j + 1) * a_dim1 + 1], lda, dgemv_((char *)"N", n, &i__1, &c_b20, &a[(j + 1) * a_dim1 + 1], lda, &work[j + 1], &c__1,
&work[j + 1], &c__1, &c_b22, &a[j * a_dim1 + 1], &c__1, (ftnlen)12); &c_b22, &a[j * a_dim1 + 1], &c__1, (ftnlen)1);
} }
} }
} else { } else {
@ -103,12 +104,12 @@ int dgetri_(integer *n, doublereal *a, integer *lda, integer *ipiv, doublereal *
} }
if (j + jb <= *n) { if (j + jb <= *n) {
i__2 = *n - j - jb + 1; i__2 = *n - j - jb + 1;
dgemm_((char *)"No transpose", (char *)"No transpose", n, &jb, &i__2, &c_b20, dgemm_((char *)"N", (char *)"N", n, &jb, &i__2, &c_b20, &a[(j + jb) * a_dim1 + 1], lda,
&a[(j + jb) * a_dim1 + 1], lda, &work[j + jb], &ldwork, &c_b22, &work[j + jb], &ldwork, &c_b22, &a[j * a_dim1 + 1], lda, (ftnlen)1,
&a[j * a_dim1 + 1], lda, (ftnlen)12, (ftnlen)12); (ftnlen)1);
} }
dtrsm_((char *)"Right", (char *)"Lower", (char *)"No transpose", (char *)"Unit", n, &jb, &c_b22, &work[j], &ldwork, dtrsm_((char *)"R", (char *)"L", (char *)"N", (char *)"U", n, &jb, &c_b22, &work[j], &ldwork, &a[j * a_dim1 + 1], lda,
&a[j * a_dim1 + 1], lda, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
} }
for (j = *n - 1; j >= 1; --j) { for (j = *n - 1; j >= 1; --j) {

16
lib/linalg/dgetrs.cpp
View File

@ -47,15 +47,15 @@ int dgetrs_(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda,
} }
if (notran) { if (notran) {
dlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c__1); dlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c__1);
dtrsm_((char *)"Left", (char *)"Lower", (char *)"No transpose", (char *)"Unit", n, nrhs, &c_b12, &a[a_offset], lda, dtrsm_((char *)"L", (char *)"L", (char *)"N", (char *)"U", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
&b[b_offset], ldb, (ftnlen)4, (ftnlen)5, (ftnlen)12, (ftnlen)4); (ftnlen)1, (ftnlen)1, (ftnlen)1);
dtrsm_((char *)"Left", (char *)"Upper", (char *)"No transpose", (char *)"Non-unit", n, nrhs, &c_b12, &a[a_offset], lda, dtrsm_((char *)"L", (char *)"U", (char *)"N", (char *)"N", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
&b[b_offset], ldb, (ftnlen)4, (ftnlen)5, (ftnlen)12, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1);
} else { } else {
dtrsm_((char *)"Left", (char *)"Upper", (char *)"Transpose", (char *)"Non-unit", n, nrhs, &c_b12, &a[a_offset], lda, dtrsm_((char *)"L", (char *)"U", (char *)"T", (char *)"N", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
&b[b_offset], ldb, (ftnlen)4, (ftnlen)5, (ftnlen)9, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1);
dtrsm_((char *)"Left", (char *)"Lower", (char *)"Transpose", (char *)"Unit", n, nrhs, &c_b12, &a[a_offset], lda, dtrsm_((char *)"L", (char *)"L", (char *)"T", (char *)"U", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
&b[b_offset], ldb, (ftnlen)4, (ftnlen)5, (ftnlen)9, (ftnlen)4); (ftnlen)1, (ftnlen)1, (ftnlen)1);
dlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c_n1); dlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c_n1);
} }
return 0; return 0;

2
lib/linalg/dhseqr.cpp
View File

@ -104,7 +104,7 @@ int dhseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, doub
i__2[1] = 1, a__1[1] = compz; i__2[1] = 1, a__1[1] = compz;
s_lmp_cat(ch__1, a__1, i__2, &c__2, (ftnlen)2); s_lmp_cat(ch__1, a__1, i__2, &c__2, (ftnlen)2);
nmin = ilaenv_(&c__12, (char *)"DHSEQR", ch__1, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); nmin = ilaenv_(&c__12, (char *)"DHSEQR", ch__1, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
nmin = max(11, nmin); nmin = max(15, nmin);
if (*n > nmin) { if (*n > nmin) {
dlaqr0_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi, dlaqr0_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi,
&z__[z_offset], ldz, &work[1], lwork, info); &z__[z_offset], ldz, &work[1], lwork, info);

122
lib/linalg/dlabrd.cpp
View File

@ -37,12 +37,12 @@ int dlabrd_(integer *m, integer *n, integer *nb, doublereal *a, integer *lda, do
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b4, &a[i__ + a_dim1], lda, &y[i__ + y_dim1], dgemv_((char *)"N", &i__2, &i__3, &c_b4, &a[i__ + a_dim1], lda, &y[i__ + y_dim1], ldy, &c_b5,
ldy, &c_b5, &a[i__ + i__ * a_dim1], &c__1, (ftnlen)12); &a[i__ + i__ * a_dim1], &c__1, (ftnlen)1);
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b4, &x[i__ + x_dim1], ldx, &a[i__ * a_dim1 + 1], dgemv_((char *)"N", &i__2, &i__3, &c_b4, &x[i__ + x_dim1], ldx, &a[i__ * a_dim1 + 1], &c__1,
&c__1, &c_b5, &a[i__ + i__ * a_dim1], &c__1, (ftnlen)12); &c_b5, &a[i__ + i__ * a_dim1], &c__1, (ftnlen)1);
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
i__3 = i__ + 1; i__3 = i__ + 1;
dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m) + i__ * a_dim1], &c__1, dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m) + i__ * a_dim1], &c__1,
@ -52,38 +52,35 @@ int dlabrd_(integer *m, integer *n, integer *nb, doublereal *a, integer *lda, do
a[i__ + i__ * a_dim1] = 1.; a[i__ + i__ * a_dim1] = 1.;
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
i__3 = *n - i__; i__3 = *n - i__;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b5, &a[i__ + (i__ + 1) * a_dim1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b5, &a[i__ + (i__ + 1) * a_dim1], lda,
&a[i__ + i__ * a_dim1], &c__1, &c_b16, &y[i__ + 1 + i__ * y_dim1], &c__1, &a[i__ + i__ * a_dim1], &c__1, &c_b16, &y[i__ + 1 + i__ * y_dim1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b5, &a[i__ + a_dim1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b5, &a[i__ + a_dim1], lda, &a[i__ + i__ * a_dim1],
&a[i__ + i__ * a_dim1], &c__1, &c_b16, &y[i__ * y_dim1 + 1], &c__1, &c__1, &c_b16, &y[i__ * y_dim1 + 1], &c__1, (ftnlen)1);
(ftnlen)9);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b4, &y[i__ + 1 + y_dim1], ldy, dgemv_((char *)"N", &i__2, &i__3, &c_b4, &y[i__ + 1 + y_dim1], ldy, &y[i__ * y_dim1 + 1],
&y[i__ * y_dim1 + 1], &c__1, &c_b5, &y[i__ + 1 + i__ * y_dim1], &c__1, &c__1, &c_b5, &y[i__ + 1 + i__ * y_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b5, &x[i__ + x_dim1], ldx, dgemv_((char *)"T", &i__2, &i__3, &c_b5, &x[i__ + x_dim1], ldx, &a[i__ + i__ * a_dim1],
&a[i__ + i__ * a_dim1], &c__1, &c_b16, &y[i__ * y_dim1 + 1], &c__1, &c__1, &c_b16, &y[i__ * y_dim1 + 1], &c__1, (ftnlen)1);
(ftnlen)9);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b4, &a[(i__ + 1) * a_dim1 + 1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b4, &a[(i__ + 1) * a_dim1 + 1], lda,
&y[i__ * y_dim1 + 1], &c__1, &c_b5, &y[i__ + 1 + i__ * y_dim1], &c__1, &y[i__ * y_dim1 + 1], &c__1, &c_b5, &y[i__ + 1 + i__ * y_dim1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
dscal_(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1); dscal_(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1);
i__2 = *n - i__; i__2 = *n - i__;
dgemv_((char *)"No transpose", &i__2, &i__, &c_b4, &y[i__ + 1 + y_dim1], ldy, dgemv_((char *)"N", &i__2, &i__, &c_b4, &y[i__ + 1 + y_dim1], ldy, &a[i__ + a_dim1], lda,
&a[i__ + a_dim1], lda, &c_b5, &a[i__ + (i__ + 1) * a_dim1], lda, (ftnlen)12); &c_b5, &a[i__ + (i__ + 1) * a_dim1], lda, (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b4, &a[(i__ + 1) * a_dim1 + 1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b4, &a[(i__ + 1) * a_dim1 + 1], lda, &x[i__ + x_dim1],
&x[i__ + x_dim1], ldx, &c_b5, &a[i__ + (i__ + 1) * a_dim1], lda, (ftnlen)9); ldx, &c_b5, &a[i__ + (i__ + 1) * a_dim1], lda, (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ + 2; i__3 = i__ + 2;
dlarfg_(&i__2, &a[i__ + (i__ + 1) * a_dim1], &a[i__ + min(i__3, *n) * a_dim1], lda, dlarfg_(&i__2, &a[i__ + (i__ + 1) * a_dim1], &a[i__ + min(i__3, *n) * a_dim1], lda,
@ -92,27 +89,25 @@ int dlabrd_(integer *m, integer *n, integer *nb, doublereal *a, integer *lda, do
a[i__ + (i__ + 1) * a_dim1] = 1.; a[i__ + (i__ + 1) * a_dim1] = 1.;
i__2 = *m - i__; i__2 = *m - i__;
i__3 = *n - i__; i__3 = *n - i__;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b5, &a[i__ + 1 + (i__ + 1) * a_dim1], lda, dgemv_((char *)"N", &i__2, &i__3, &c_b5, &a[i__ + 1 + (i__ + 1) * a_dim1], lda,
&a[i__ + (i__ + 1) * a_dim1], lda, &c_b16, &x[i__ + 1 + i__ * x_dim1], &c__1, &a[i__ + (i__ + 1) * a_dim1], lda, &c_b16, &x[i__ + 1 + i__ * x_dim1], &c__1,
(ftnlen)12); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
dgemv_((char *)"Transpose", &i__2, &i__, &c_b5, &y[i__ + 1 + y_dim1], ldy, dgemv_((char *)"T", &i__2, &i__, &c_b5, &y[i__ + 1 + y_dim1], ldy,
&a[i__ + (i__ + 1) * a_dim1], lda, &c_b16, &x[i__ * x_dim1 + 1], &c__1, &a[i__ + (i__ + 1) * a_dim1], lda, &c_b16, &x[i__ * x_dim1 + 1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = *m - i__; i__2 = *m - i__;
dgemv_((char *)"No transpose", &i__2, &i__, &c_b4, &a[i__ + 1 + a_dim1], lda, dgemv_((char *)"N", &i__2, &i__, &c_b4, &a[i__ + 1 + a_dim1], lda, &x[i__ * x_dim1 + 1],
&x[i__ * x_dim1 + 1], &c__1, &c_b5, &x[i__ + 1 + i__ * x_dim1], &c__1, &c__1, &c_b5, &x[i__ + 1 + i__ * x_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b5, &a[(i__ + 1) * a_dim1 + 1], lda, dgemv_((char *)"N", &i__2, &i__3, &c_b5, &a[(i__ + 1) * a_dim1 + 1], lda,
&a[i__ + (i__ + 1) * a_dim1], lda, &c_b16, &x[i__ * x_dim1 + 1], &c__1, &a[i__ + (i__ + 1) * a_dim1], lda, &c_b16, &x[i__ * x_dim1 + 1], &c__1,
(ftnlen)12); (ftnlen)1);
i__2 = *m - i__; i__2 = *m - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b4, &x[i__ + 1 + x_dim1], ldx, dgemv_((char *)"N", &i__2, &i__3, &c_b4, &x[i__ + 1 + x_dim1], ldx, &x[i__ * x_dim1 + 1],
&x[i__ * x_dim1 + 1], &c__1, &c_b5, &x[i__ + 1 + i__ * x_dim1], &c__1, &c__1, &c_b5, &x[i__ + 1 + i__ * x_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = *m - i__; i__2 = *m - i__;
dscal_(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1); dscal_(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1);
} }
@ -122,12 +117,12 @@ int dlabrd_(integer *m, integer *n, integer *nb, doublereal *a, integer *lda, do
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = *n - i__ + 1; i__2 = *n - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b4, &y[i__ + y_dim1], ldy, &a[i__ + a_dim1], dgemv_((char *)"N", &i__2, &i__3, &c_b4, &y[i__ + y_dim1], ldy, &a[i__ + a_dim1], lda, &c_b5,
lda, &c_b5, &a[i__ + i__ * a_dim1], lda, (ftnlen)12); &a[i__ + i__ * a_dim1], lda, (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__ + 1; i__3 = *n - i__ + 1;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b4, &a[i__ * a_dim1 + 1], lda, &x[i__ + x_dim1], dgemv_((char *)"T", &i__2, &i__3, &c_b4, &a[i__ * a_dim1 + 1], lda, &x[i__ + x_dim1], ldx,
ldx, &c_b5, &a[i__ + i__ * a_dim1], lda, (ftnlen)9); &c_b5, &a[i__ + i__ * a_dim1], lda, (ftnlen)1);
i__2 = *n - i__ + 1; i__2 = *n - i__ + 1;
i__3 = i__ + 1; i__3 = i__ + 1;
dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n) * a_dim1], lda, dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n) * a_dim1], lda,
@ -137,38 +132,34 @@ int dlabrd_(integer *m, integer *n, integer *nb, doublereal *a, integer *lda, do
a[i__ + i__ * a_dim1] = 1.; a[i__ + i__ * a_dim1] = 1.;
i__2 = *m - i__; i__2 = *m - i__;
i__3 = *n - i__ + 1; i__3 = *n - i__ + 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b5, &a[i__ + 1 + i__ * a_dim1], lda, dgemv_((char *)"N", &i__2, &i__3, &c_b5, &a[i__ + 1 + i__ * a_dim1], lda,
&a[i__ + i__ * a_dim1], lda, &c_b16, &x[i__ + 1 + i__ * x_dim1], &c__1, &a[i__ + i__ * a_dim1], lda, &c_b16, &x[i__ + 1 + i__ * x_dim1], &c__1,
(ftnlen)12); (ftnlen)1);
i__2 = *n - i__ + 1; i__2 = *n - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b5, &y[i__ + y_dim1], ldy, dgemv_((char *)"T", &i__2, &i__3, &c_b5, &y[i__ + y_dim1], ldy, &a[i__ + i__ * a_dim1], lda,
&a[i__ + i__ * a_dim1], lda, &c_b16, &x[i__ * x_dim1 + 1], &c__1, (ftnlen)9); &c_b16, &x[i__ * x_dim1 + 1], &c__1, (ftnlen)1);
i__2 = *m - i__; i__2 = *m - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b4, &a[i__ + 1 + a_dim1], lda, dgemv_((char *)"N", &i__2, &i__3, &c_b4, &a[i__ + 1 + a_dim1], lda, &x[i__ * x_dim1 + 1],
&x[i__ * x_dim1 + 1], &c__1, &c_b5, &x[i__ + 1 + i__ * x_dim1], &c__1, &c__1, &c_b5, &x[i__ + 1 + i__ * x_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__ + 1; i__3 = *n - i__ + 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b5, &a[i__ * a_dim1 + 1], lda, dgemv_((char *)"N", &i__2, &i__3, &c_b5, &a[i__ * a_dim1 + 1], lda, &a[i__ + i__ * a_dim1],
&a[i__ + i__ * a_dim1], lda, &c_b16, &x[i__ * x_dim1 + 1], &c__1, lda, &c_b16, &x[i__ * x_dim1 + 1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = *m - i__; i__2 = *m - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b4, &x[i__ + 1 + x_dim1], ldx, dgemv_((char *)"N", &i__2, &i__3, &c_b4, &x[i__ + 1 + x_dim1], ldx, &x[i__ * x_dim1 + 1],
&x[i__ * x_dim1 + 1], &c__1, &c_b5, &x[i__ + 1 + i__ * x_dim1], &c__1, &c__1, &c_b5, &x[i__ + 1 + i__ * x_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = *m - i__; i__2 = *m - i__;
dscal_(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1); dscal_(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1);
i__2 = *m - i__; i__2 = *m - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b4, &a[i__ + 1 + a_dim1], lda, dgemv_((char *)"N", &i__2, &i__3, &c_b4, &a[i__ + 1 + a_dim1], lda, &y[i__ + y_dim1], ldy,
&y[i__ + y_dim1], ldy, &c_b5, &a[i__ + 1 + i__ * a_dim1], &c__1, (ftnlen)12); &c_b5, &a[i__ + 1 + i__ * a_dim1], &c__1, (ftnlen)1);
i__2 = *m - i__; i__2 = *m - i__;
dgemv_((char *)"No transpose", &i__2, &i__, &c_b4, &x[i__ + 1 + x_dim1], ldx, dgemv_((char *)"N", &i__2, &i__, &c_b4, &x[i__ + 1 + x_dim1], ldx, &a[i__ * a_dim1 + 1],
&a[i__ * a_dim1 + 1], &c__1, &c_b5, &a[i__ + 1 + i__ * a_dim1], &c__1, &c__1, &c_b5, &a[i__ + 1 + i__ * a_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = *m - i__; i__2 = *m - i__;
i__3 = i__ + 2; i__3 = i__ + 2;
dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *m) + i__ * a_dim1], &c__1, dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *m) + i__ * a_dim1], &c__1,
@ -177,27 +168,26 @@ int dlabrd_(integer *m, integer *n, integer *nb, doublereal *a, integer *lda, do
a[i__ + 1 + i__ * a_dim1] = 1.; a[i__ + 1 + i__ * a_dim1] = 1.;
i__2 = *m - i__; i__2 = *m - i__;
i__3 = *n - i__; i__3 = *n - i__;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b5, &a[i__ + 1 + (i__ + 1) * a_dim1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b5, &a[i__ + 1 + (i__ + 1) * a_dim1], lda,
&a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &y[i__ + 1 + i__ * y_dim1], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &y[i__ + 1 + i__ * y_dim1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = *m - i__; i__2 = *m - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b5, &a[i__ + 1 + a_dim1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b5, &a[i__ + 1 + a_dim1], lda,
&a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &y[i__ * y_dim1 + 1], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &y[i__ * y_dim1 + 1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b4, &y[i__ + 1 + y_dim1], ldy, dgemv_((char *)"N", &i__2, &i__3, &c_b4, &y[i__ + 1 + y_dim1], ldy, &y[i__ * y_dim1 + 1],
&y[i__ * y_dim1 + 1], &c__1, &c_b5, &y[i__ + 1 + i__ * y_dim1], &c__1, &c__1, &c_b5, &y[i__ + 1 + i__ * y_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = *m - i__; i__2 = *m - i__;
dgemv_((char *)"Transpose", &i__2, &i__, &c_b5, &x[i__ + 1 + x_dim1], ldx, dgemv_((char *)"T", &i__2, &i__, &c_b5, &x[i__ + 1 + x_dim1], ldx,
&a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &y[i__ * y_dim1 + 1], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &y[i__ * y_dim1 + 1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
dgemv_((char *)"Transpose", &i__, &i__2, &c_b4, &a[(i__ + 1) * a_dim1 + 1], lda, dgemv_((char *)"T", &i__, &i__2, &c_b4, &a[(i__ + 1) * a_dim1 + 1], lda,
&y[i__ * y_dim1 + 1], &c__1, &c_b5, &y[i__ + 1 + i__ * y_dim1], &c__1, &y[i__ * y_dim1 + 1], &c__1, &c_b5, &y[i__ + 1 + i__ * y_dim1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
dscal_(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1); dscal_(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1);
} }

2
lib/linalg/dlaexc.cpp
View File

@ -74,7 +74,7 @@ int dlaexc_(logical *wantq, integer *n, doublereal *t, integer *ldt, doublereal
} }
} else { } else {
nd = *n1 + *n2; nd = *n1 + *n2;
dlacpy_((char *)"Full", &nd, &nd, &t[*j1 + *j1 * t_dim1], ldt, d__, &c__4, (ftnlen)4); dlacpy_((char *)"F", &nd, &nd, &t[*j1 + *j1 * t_dim1], ldt, d__, &c__4, (ftnlen)1);
dnorm = dlange_((char *)"Max", &nd, &nd, d__, &c__4, &work[1], (ftnlen)3); dnorm = dlange_((char *)"Max", &nd, &nd, d__, &c__4, &work[1], (ftnlen)3);
eps = dlamch_((char *)"P", (ftnlen)1); eps = dlamch_((char *)"P", (ftnlen)1);
smlnum = dlamch_((char *)"S", (ftnlen)1) / eps; smlnum = dlamch_((char *)"S", (ftnlen)1) / eps;

28
lib/linalg/dlahqr.cpp
View File

@ -23,12 +23,12 @@ int dlahqr_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
integer its; integer its;
doublereal ulp, sum, tst, rt1i, rt2i, rt1r, rt2r; doublereal ulp, sum, tst, rt1i, rt2i, rt1r, rt2r;
extern int drot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, extern int drot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *,
doublereal *), doublereal *);
dcopy_(integer *, doublereal *, integer *, doublereal *, integer *); integer kdefl;
extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *);
integer itmax; integer itmax;
extern int dlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, extern int dlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), doublereal *, doublereal *, doublereal *, doublereal *, doublereal *);
dlabad_(doublereal *, doublereal *);
extern doublereal dlamch_(char *, ftnlen); extern doublereal dlamch_(char *, ftnlen);
extern int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *); extern int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *);
doublereal safmin, safmax, rtdisc, smlnum; doublereal safmin, safmax, rtdisc, smlnum;
@ -61,7 +61,6 @@ int dlahqr_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
nz = *ihiz - *iloz + 1; nz = *ihiz - *iloz + 1;
safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12); safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12);
safmax = 1. / safmin; safmax = 1. / safmin;
dlabad_(&safmin, &safmax);
ulp = dlamch_((char *)"PRECISION", (ftnlen)9); ulp = dlamch_((char *)"PRECISION", (ftnlen)9);
smlnum = safmin * ((doublereal)nh / ulp); smlnum = safmin * ((doublereal)nh / ulp);
if (*wantt) { if (*wantt) {
@ -69,6 +68,7 @@ int dlahqr_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
i2 = *n; i2 = *n;
} }
itmax = max(10, nh) * 30; itmax = max(10, nh) * 30;
kdefl = 0;
i__ = *ihi; i__ = *ihi;
L20: L20:
l = *ilo; l = *ilo;
@ -120,24 +120,25 @@ L20:
if (l >= i__ - 1) { if (l >= i__ - 1) {
goto L150; goto L150;
} }
++kdefl;
if (!(*wantt)) { if (!(*wantt)) {
i1 = l; i1 = l;
i2 = i__; i2 = i__;
} }
if (its == 10) { if (kdefl % 20 == 0) {
s = (d__1 = h__[l + 1 + l * h_dim1], abs(d__1)) +
(d__2 = h__[l + 2 + (l + 1) * h_dim1], abs(d__2));
h11 = s * .75 + h__[l + l * h_dim1];
h12 = s * -.4375;
h21 = s;
h22 = h11;
} else if (its == 20) {
s = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1)) + s = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1)) +
(d__2 = h__[i__ - 1 + (i__ - 2) * h_dim1], abs(d__2)); (d__2 = h__[i__ - 1 + (i__ - 2) * h_dim1], abs(d__2));
h11 = s * .75 + h__[i__ + i__ * h_dim1]; h11 = s * .75 + h__[i__ + i__ * h_dim1];
h12 = s * -.4375; h12 = s * -.4375;
h21 = s; h21 = s;
h22 = h11; h22 = h11;
} else if (kdefl % 10 == 0) {
s = (d__1 = h__[l + 1 + l * h_dim1], abs(d__1)) +
(d__2 = h__[l + 2 + (l + 1) * h_dim1], abs(d__2));
h11 = s * .75 + h__[l + l * h_dim1];
h12 = s * -.4375;
h21 = s;
h22 = h11;
} else { } else {
h11 = h__[i__ - 1 + (i__ - 1) * h_dim1]; h11 = h__[i__ - 1 + (i__ - 1) * h_dim1];
h21 = h__[i__ + (i__ - 1) * h_dim1]; h21 = h__[i__ + (i__ - 1) * h_dim1];
@ -301,6 +302,7 @@ L150:
&cs, &sn); &cs, &sn);
} }
} }
kdefl = 0;
i__ = l - 1; i__ = l - 1;
goto L20; goto L20;
L160: L160:

56
lib/linalg/dlahr2.cpp
View File

@ -46,30 +46,28 @@ int dlahr2_(integer *n, integer *k, integer *nb, doublereal *a, integer *lda, do
if (i__ > 1) { if (i__ > 1) {
i__2 = *n - *k; i__2 = *n - *k;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"NO TRANSPOSE", &i__2, &i__3, &c_b4, &y[*k + 1 + y_dim1], ldy, dgemv_((char *)"T", &i__2, &i__3, &c_b4, &y[*k + 1 + y_dim1], ldy, &a[*k + i__ - 1 + a_dim1],
&a[*k + i__ - 1 + a_dim1], lda, &c_b5, &a[*k + 1 + i__ * a_dim1], &c__1, lda, &c_b5, &a[*k + 1 + i__ * a_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = i__ - 1; i__2 = i__ - 1;
dcopy_(&i__2, &a[*k + 1 + i__ * a_dim1], &c__1, &t[*nb * t_dim1 + 1], &c__1); dcopy_(&i__2, &a[*k + 1 + i__ * a_dim1], &c__1, &t[*nb * t_dim1 + 1], &c__1);
i__2 = i__ - 1; i__2 = i__ - 1;
dtrmv_((char *)"Lower", (char *)"Transpose", (char *)"UNIT", &i__2, &a[*k + 1 + a_dim1], lda, dtrmv_((char *)"L", (char *)"T", (char *)"U", &i__2, &a[*k + 1 + a_dim1], lda, &t[*nb * t_dim1 + 1], &c__1,
&t[*nb * t_dim1 + 1], &c__1, (ftnlen)5, (ftnlen)9, (ftnlen)4); (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__2 = *n - *k - i__ + 1; i__2 = *n - *k - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b5, &a[*k + i__ + a_dim1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b5, &a[*k + i__ + a_dim1], lda,
&a[*k + i__ + i__ * a_dim1], &c__1, &c_b5, &t[*nb * t_dim1 + 1], &c__1, &a[*k + i__ + i__ * a_dim1], &c__1, &c_b5, &t[*nb * t_dim1 + 1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
dtrmv_((char *)"Upper", (char *)"Transpose", (char *)"NON-UNIT", &i__2, &t[t_offset], ldt, &t[*nb * t_dim1 + 1], dtrmv_((char *)"U", (char *)"T", (char *)"N", &i__2, &t[t_offset], ldt, &t[*nb * t_dim1 + 1], &c__1, (ftnlen)1,
&c__1, (ftnlen)5, (ftnlen)9, (ftnlen)8); (ftnlen)1, (ftnlen)1);
i__2 = *n - *k - i__ + 1; i__2 = *n - *k - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"NO TRANSPOSE", &i__2, &i__3, &c_b4, &a[*k + i__ + a_dim1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b4, &a[*k + i__ + a_dim1], lda, &t[*nb * t_dim1 + 1],
&t[*nb * t_dim1 + 1], &c__1, &c_b5, &a[*k + i__ + i__ * a_dim1], &c__1, &c__1, &c_b5, &a[*k + i__ + i__ * a_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = i__ - 1; i__2 = i__ - 1;
dtrmv_((char *)"Lower", (char *)"NO TRANSPOSE", (char *)"UNIT", &i__2, &a[*k + 1 + a_dim1], lda, dtrmv_((char *)"L", (char *)"T", (char *)"U", &i__2, &a[*k + 1 + a_dim1], lda, &t[*nb * t_dim1 + 1], &c__1,
&t[*nb * t_dim1 + 1], &c__1, (ftnlen)5, (ftnlen)12, (ftnlen)4); (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
daxpy_(&i__2, &c_b4, &t[*nb * t_dim1 + 1], &c__1, &a[*k + 1 + i__ * a_dim1], &c__1); daxpy_(&i__2, &c_b4, &t[*nb * t_dim1 + 1], &c__1, &a[*k + 1 + i__ * a_dim1], &c__1);
a[*k + i__ - 1 + (i__ - 1) * a_dim1] = ei; a[*k + i__ - 1 + (i__ - 1) * a_dim1] = ei;
@ -82,38 +80,38 @@ int dlahr2_(integer *n, integer *k, integer *nb, doublereal *a, integer *lda, do
a[*k + i__ + i__ * a_dim1] = 1.; a[*k + i__ + i__ * a_dim1] = 1.;
i__2 = *n - *k; i__2 = *n - *k;
i__3 = *n - *k - i__ + 1; i__3 = *n - *k - i__ + 1;
dgemv_((char *)"NO TRANSPOSE", &i__2, &i__3, &c_b5, &a[*k + 1 + (i__ + 1) * a_dim1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b5, &a[*k + 1 + (i__ + 1) * a_dim1], lda,
&a[*k + i__ + i__ * a_dim1], &c__1, &c_b38, &y[*k + 1 + i__ * y_dim1], &c__1, &a[*k + i__ + i__ * a_dim1], &c__1, &c_b38, &y[*k + 1 + i__ * y_dim1], &c__1,
(ftnlen)12); (ftnlen)1);
i__2 = *n - *k - i__ + 1; i__2 = *n - *k - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b5, &a[*k + i__ + a_dim1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b5, &a[*k + i__ + a_dim1], lda, &a[*k + i__ + i__ * a_dim1],
&a[*k + i__ + i__ * a_dim1], &c__1, &c_b38, &t[i__ * t_dim1 + 1], &c__1, (ftnlen)9); &c__1, &c_b38, &t[i__ * t_dim1 + 1], &c__1, (ftnlen)1);
i__2 = *n - *k; i__2 = *n - *k;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"NO TRANSPOSE", &i__2, &i__3, &c_b4, &y[*k + 1 + y_dim1], ldy, &t[i__ * t_dim1 + 1], dgemv_((char *)"T", &i__2, &i__3, &c_b4, &y[*k + 1 + y_dim1], ldy, &t[i__ * t_dim1 + 1], &c__1,
&c__1, &c_b5, &y[*k + 1 + i__ * y_dim1], &c__1, (ftnlen)12); &c_b5, &y[*k + 1 + i__ * y_dim1], &c__1, (ftnlen)1);
i__2 = *n - *k; i__2 = *n - *k;
dscal_(&i__2, &tau[i__], &y[*k + 1 + i__ * y_dim1], &c__1); dscal_(&i__2, &tau[i__], &y[*k + 1 + i__ * y_dim1], &c__1);
i__2 = i__ - 1; i__2 = i__ - 1;
d__1 = -tau[i__]; d__1 = -tau[i__];
dscal_(&i__2, &d__1, &t[i__ * t_dim1 + 1], &c__1); dscal_(&i__2, &d__1, &t[i__ * t_dim1 + 1], &c__1);
i__2 = i__ - 1; i__2 = i__ - 1;
dtrmv_((char *)"Upper", (char *)"No Transpose", (char *)"NON-UNIT", &i__2, &t[t_offset], ldt, &t[i__ * t_dim1 + 1], dtrmv_((char *)"U", (char *)"N", (char *)"N", &i__2, &t[t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1, (ftnlen)1,
&c__1, (ftnlen)5, (ftnlen)12, (ftnlen)8); (ftnlen)1, (ftnlen)1);
t[i__ + i__ * t_dim1] = tau[i__]; t[i__ + i__ * t_dim1] = tau[i__];
} }
a[*k + *nb + *nb * a_dim1] = ei; a[*k + *nb + *nb * a_dim1] = ei;
dlacpy_((char *)"ALL", k, nb, &a[(a_dim1 << 1) + 1], lda, &y[y_offset], ldy, (ftnlen)3); dlacpy_((char *)"A", k, nb, &a[(a_dim1 << 1) + 1], lda, &y[y_offset], ldy, (ftnlen)1);
dtrmm_((char *)"RIGHT", (char *)"Lower", (char *)"NO TRANSPOSE", (char *)"UNIT", k, nb, &c_b5, &a[*k + 1 + a_dim1], lda, dtrmm_((char *)"R", (char *)"L", (char *)"T", (char *)"U", k, nb, &c_b5, &a[*k + 1 + a_dim1], lda, &y[y_offset], ldy, (ftnlen)1,
&y[y_offset], ldy, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4); (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k + *nb) { if (*n > *k + *nb) {
i__1 = *n - *k - *nb; i__1 = *n - *k - *nb;
dgemm_((char *)"NO TRANSPOSE", (char *)"NO TRANSPOSE", k, nb, &i__1, &c_b5, &a[(*nb + 2) * a_dim1 + 1], lda, dgemm_((char *)"T", (char *)"T", k, nb, &i__1, &c_b5, &a[(*nb + 2) * a_dim1 + 1], lda,
&a[*k + 1 + *nb + a_dim1], lda, &c_b5, &y[y_offset], ldy, (ftnlen)12, (ftnlen)12); &a[*k + 1 + *nb + a_dim1], lda, &c_b5, &y[y_offset], ldy, (ftnlen)1, (ftnlen)1);
} }
dtrmm_((char *)"RIGHT", (char *)"Upper", (char *)"NO TRANSPOSE", (char *)"NON-UNIT", k, nb, &c_b5, &t[t_offset], ldt, dtrmm_((char *)"R", (char *)"U", (char *)"T", (char *)"N", k, nb, &c_b5, &t[t_offset], ldt, &y[y_offset], ldy, (ftnlen)1,
&y[y_offset], ldy, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1);
return 0; return 0;
} }
#ifdef __cplusplus #ifdef __cplusplus

48
lib/linalg/dlanv2.cpp
View File

@ -2,16 +2,28 @@
extern "C" { extern "C" {
#endif #endif
#include "lmp_f2c.h" #include "lmp_f2c.h"
static doublereal c_b3 = 1.; static doublereal c_b6 = 1.;
int dlanv2_(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doublereal *rt1r, int dlanv2_(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doublereal *rt1r,
doublereal *rt1i, doublereal *rt2r, doublereal *rt2i, doublereal *cs, doublereal *sn) doublereal *rt1i, doublereal *rt2r, doublereal *rt2i, doublereal *cs, doublereal *sn)
{ {
integer i__1;
doublereal d__1, d__2; doublereal d__1, d__2;
double d_lmp_sign(doublereal *, doublereal *), sqrt(doublereal); double log(doublereal), pow_lmp_di(doublereal *, integer *), d_lmp_sign(doublereal *, doublereal *),
sqrt(doublereal);
doublereal p, z__, aa, bb, cc, dd, cs1, sn1, sab, sac, eps, tau, temp, scale, bcmax, bcmis, doublereal p, z__, aa, bb, cc, dd, cs1, sn1, sab, sac, eps, tau, temp, scale, bcmax, bcmis,
sigma; sigma;
extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *, ftnlen); integer count;
doublereal safmn2;
extern doublereal dlapy2_(doublereal *, doublereal *);
doublereal safmx2;
extern doublereal dlamch_(char *, ftnlen);
doublereal safmin;
safmin = dlamch_((char *)"S", (ftnlen)1);
eps = dlamch_((char *)"P", (ftnlen)1); eps = dlamch_((char *)"P", (ftnlen)1);
d__1 = dlamch_((char *)"B", (ftnlen)1);
i__1 = (integer)(log(safmin / eps) / log(dlamch_((char *)"B", (ftnlen)1)) / 2.);
safmn2 = pow_lmp_di(&d__1, &i__1);
safmx2 = 1. / safmn2;
if (*c__ == 0.) { if (*c__ == 0.) {
*cs = 1.; *cs = 1.;
*sn = 0.; *sn = 0.;
@ -23,7 +35,7 @@ int dlanv2_(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doub
*a = temp; *a = temp;
*b = -(*c__); *b = -(*c__);
*c__ = 0.; *c__ = 0.;
} else if (*a - *d__ == 0. && d_lmp_sign(&c_b3, b) != d_lmp_sign(&c_b3, c__)) { } else if (*a - *d__ == 0. && d_lmp_sign(&c_b6, b) != d_lmp_sign(&c_b6, c__)) {
*cs = 1.; *cs = 1.;
*sn = 0.; *sn = 0.;
} else { } else {
@ -32,7 +44,7 @@ int dlanv2_(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doub
d__1 = abs(*b), d__2 = abs(*c__); d__1 = abs(*b), d__2 = abs(*c__);
bcmax = max(d__1, d__2); bcmax = max(d__1, d__2);
d__1 = abs(*b), d__2 = abs(*c__); d__1 = abs(*b), d__2 = abs(*c__);
bcmis = min(d__1, d__2) * d_lmp_sign(&c_b3, b) * d_lmp_sign(&c_b3, c__); bcmis = min(d__1, d__2) * d_lmp_sign(&c_b6, b) * d_lmp_sign(&c_b6, c__);
d__1 = abs(p); d__1 = abs(p);
scale = max(d__1, bcmax); scale = max(d__1, bcmax);
z__ = p / scale * p + bcmax / scale * bcmis; z__ = p / scale * p + bcmax / scale * bcmis;
@ -47,24 +59,44 @@ int dlanv2_(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doub
*b -= *c__; *b -= *c__;
*c__ = 0.; *c__ = 0.;
} else { } else {
count = 0;
sigma = *b + *c__; sigma = *b + *c__;
L10:
++count;
d__1 = abs(temp), d__2 = abs(sigma);
scale = max(d__1, d__2);
if (scale >= safmx2) {
sigma *= safmn2;
temp *= safmn2;
if (count <= 20) {
goto L10;
}
}
if (scale <= safmn2) {
sigma *= safmx2;
temp *= safmx2;
if (count <= 20) {
goto L10;
}
}
p = temp * .5;
tau = dlapy2_(&sigma, &temp); tau = dlapy2_(&sigma, &temp);
*cs = sqrt((abs(sigma) / tau + 1.) * .5); *cs = sqrt((abs(sigma) / tau + 1.) * .5);
*sn = -(p / (tau * *cs)) * d_lmp_sign(&c_b3, &sigma); *sn = -(p / (tau * *cs)) * d_lmp_sign(&c_b6, &sigma);
aa = *a * *cs + *b * *sn; aa = *a * *cs + *b * *sn;
bb = -(*a) * *sn + *b * *cs; bb = -(*a) * *sn + *b * *cs;
cc = *c__ * *cs + *d__ * *sn; cc = *c__ * *cs + *d__ * *sn;
dd = -(*c__) * *sn + *d__ * *cs; dd = -(*c__) * *sn + *d__ * *cs;
*a = aa * *cs + cc * *sn; *a = aa * *cs + cc * *sn;
*b = bb * *cs + dd * *sn; *b = bb * *cs + dd * *sn;
*c__ = -aa * *sn + cc * *cs; *c__ = -(aa * *sn) + cc * *cs;
*d__ = -bb * *sn + dd * *cs; *d__ = -bb * *sn + dd * *cs;
temp = (*a + *d__) * .5; temp = (*a + *d__) * .5;
*a = temp; *a = temp;
*d__ = temp; *d__ = temp;
if (*c__ != 0.) { if (*c__ != 0.) {
if (*b != 0.) { if (*b != 0.) {
if (d_lmp_sign(&c_b3, b) == d_lmp_sign(&c_b3, c__)) { if (d_lmp_sign(&c_b6, b) == d_lmp_sign(&c_b6, c__)) {
sab = sqrt((abs(*b))); sab = sqrt((abs(*b)));
sac = sqrt((abs(*c__))); sac = sqrt((abs(*c__)));
d__1 = sab * sac; d__1 = sab * sac;

10
lib/linalg/dlaqr0.cpp
View File

@ -69,7 +69,7 @@ int dlaqr0_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
work[1] = 1.; work[1] = 1.;
return 0; return 0;
} }
if (*n <= 11) { if (*n <= 15) {
lwkopt = 1; lwkopt = 1;
if (*lwork != -1) { if (*lwork != -1) {
dlahqr_(wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], iloz, ihiz, dlahqr_(wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], iloz, ihiz,
@ -92,7 +92,7 @@ int dlaqr0_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1, i__2); i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1, i__2);
nwr = min(i__1, nwr); nwr = min(i__1, nwr);
nsr = ilaenv_(&c__15, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); nsr = ilaenv_(&c__15, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
i__1 = nsr, i__2 = (*n + 6) / 9, i__1 = min(i__1, i__2), i__2 = *ihi - *ilo; i__1 = nsr, i__2 = (*n - 3) / 6, i__1 = min(i__1, i__2), i__2 = *ihi - *ilo;
nsr = min(i__1, i__2); nsr = min(i__1, i__2);
i__1 = 2, i__2 = nsr - nsr % 2; i__1 = 2, i__2 = nsr - nsr % 2;
nsr = max(i__1, i__2); nsr = max(i__1, i__2);
@ -107,7 +107,7 @@ int dlaqr0_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
return 0; return 0;
} }
nmin = ilaenv_(&c__12, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); nmin = ilaenv_(&c__12, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
nmin = max(11, nmin); nmin = max(15, nmin);
nibble = ilaenv_(&c__14, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); nibble = ilaenv_(&c__14, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
nibble = max(0, nibble); nibble = max(0, nibble);
kacc22 = ilaenv_(&c__16, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); kacc22 = ilaenv_(&c__16, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
@ -116,7 +116,7 @@ int dlaqr0_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
i__1 = (*n - 1) / 3, i__2 = *lwork / 2; i__1 = (*n - 1) / 3, i__2 = *lwork / 2;
nwmax = min(i__1, i__2); nwmax = min(i__1, i__2);
nw = nwmax; nw = nwmax;
i__1 = (*n + 6) / 9, i__2 = (*lwork << 1) / 3; i__1 = (*n - 3) / 6, i__2 = (*lwork << 1) / 3;
nsmax = min(i__1, i__2); nsmax = min(i__1, i__2);
nsmax -= nsmax % 2; nsmax -= nsmax % 2;
ndfl = 1; ndfl = 1;
@ -278,7 +278,7 @@ int dlaqr0_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
ns = min(i__2, i__3); ns = min(i__2, i__3);
ns -= ns % 2; ns -= ns % 2;
ks = kbot - ns + 1; ks = kbot - ns + 1;
kdu = ns * 3 - 3; kdu = ns << 1;
ku = *n - kdu + 1; ku = *n - kdu + 1;
kwh = kdu + 1; kwh = kdu + 1;
nho = *n - kdu - 3 - (kdu + 1) + 1; nho = *n - kdu - 3 - (kdu + 1) + 1;

22
lib/linalg/dlaqr2.cpp
View File

@ -26,17 +26,14 @@ int dlaqr2_(logical *wantt, logical *wantz, integer *n, integer *ktop, integer *
integer lwk1, lwk2; integer lwk1, lwk2;
doublereal beta; doublereal beta;
integer kend, kcol, info, ifst, ilst, ltop, krow; integer kend, kcol, info, ifst, ilst, ltop, krow;
extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, extern int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
doublereal *, integer *, doublereal *, ftnlen), integer *, doublereal *, integer *, doublereal *, doublereal *, integer *,
dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, ftnlen, ftnlen);
integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen,
ftnlen);
logical bulge; logical bulge;
extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *); extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *);
integer infqr, kwtop; integer infqr, kwtop;
extern int dlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, extern int dlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), doublereal *, doublereal *, doublereal *, doublereal *, doublereal *);
dlabad_(doublereal *, doublereal *);
extern doublereal dlamch_(char *, ftnlen); extern doublereal dlamch_(char *, ftnlen);
extern int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, extern int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, integer *), doublereal *, integer *, integer *),
@ -57,6 +54,8 @@ int dlaqr2_(logical *wantt, logical *wantz, integer *n, integer *ktop, integer *
ftnlen); ftnlen);
logical sorted; logical sorted;
doublereal smlnum; doublereal smlnum;
extern int dlarf1f_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, doublereal *, ftnlen);
integer lwkopt; integer lwkopt;
h_dim1 = *ldh; h_dim1 = *ldh;
h_offset = 1 + h_dim1; h_offset = 1 + h_dim1;
@ -105,7 +104,6 @@ int dlaqr2_(logical *wantt, logical *wantz, integer *n, integer *ktop, integer *
} }
safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12); safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12);
safmax = 1. / safmin; safmax = 1. / safmin;
dlabad_(&safmin, &safmax);
ulp = dlamch_((char *)"PRECISION", (ftnlen)9); ulp = dlamch_((char *)"PRECISION", (ftnlen)9);
smlnum = safmin * ((doublereal)(*n) / ulp); smlnum = safmin * ((doublereal)(*n) / ulp);
i__1 = *nw, i__2 = *kbot - *ktop + 1; i__1 = *nw, i__2 = *kbot - *ktop + 1;
@ -283,14 +281,14 @@ L60:
dcopy_(ns, &v[v_offset], ldv, &work[1], &c__1); dcopy_(ns, &v[v_offset], ldv, &work[1], &c__1);
beta = work[1]; beta = work[1];
dlarfg_(ns, &beta, &work[2], &c__1, &tau); dlarfg_(ns, &beta, &work[2], &c__1, &tau);
work[1] = 1.;
i__1 = jw - 2; i__1 = jw - 2;
i__2 = jw - 2; i__2 = jw - 2;
dlaset_((char *)"L", &i__1, &i__2, &c_b12, &c_b12, &t[t_dim1 + 3], ldt, (ftnlen)1); dlaset_((char *)"L", &i__1, &i__2, &c_b12, &c_b12, &t[t_dim1 + 3], ldt, (ftnlen)1);
dlarf_((char *)"L", ns, &jw, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1], dlarf1f_((char *)"L", ns, &jw, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1],
(ftnlen)1); (ftnlen)1);
dlarf_((char *)"R", ns, ns, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1], (ftnlen)1); dlarf1f_((char *)"R", ns, ns, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1],
dlarf_((char *)"R", &jw, ns, &work[1], &c__1, &tau, &v[v_offset], ldv, &work[jw + 1], (ftnlen)1);
dlarf1f_((char *)"R", &jw, ns, &work[1], &c__1, &tau, &v[v_offset], ldv, &work[jw + 1],
(ftnlen)1); (ftnlen)1);
i__1 = *lwork - jw; i__1 = *lwork - jw;
dgehrd_(&jw, &c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1], &i__1, &info); dgehrd_(&jw, &c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1], &i__1, &info);

22
lib/linalg/dlaqr3.cpp
View File

@ -27,11 +27,9 @@ int dlaqr3_(logical *wantt, logical *wantz, integer *n, integer *ktop, integer *
integer lwk1, lwk2, lwk3; integer lwk1, lwk2, lwk3;
doublereal beta; doublereal beta;
integer kend, kcol, info, nmin, ifst, ilst, ltop, krow; integer kend, kcol, info, nmin, ifst, ilst, ltop, krow;
extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, extern int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
doublereal *, integer *, doublereal *, ftnlen), integer *, doublereal *, integer *, doublereal *, doublereal *, integer *,
dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, ftnlen, ftnlen);
integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen,
ftnlen);
logical bulge; logical bulge;
extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *); extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *);
integer infqr, kwtop; integer infqr, kwtop;
@ -39,8 +37,7 @@ int dlaqr3_(logical *wantt, logical *wantz, integer *n, integer *ktop, integer *
doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), doublereal *, doublereal *, doublereal *, doublereal *, doublereal *),
dlaqr4_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, dlaqr4_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *,
doublereal *, integer *, integer *), doublereal *, integer *, integer *);
dlabad_(doublereal *, doublereal *);
extern doublereal dlamch_(char *, ftnlen); extern doublereal dlamch_(char *, ftnlen);
extern int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, extern int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, integer *), doublereal *, integer *, integer *),
@ -63,6 +60,8 @@ int dlaqr3_(logical *wantt, logical *wantz, integer *n, integer *ktop, integer *
ftnlen); ftnlen);
logical sorted; logical sorted;
doublereal smlnum; doublereal smlnum;
extern int dlarf1f_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, doublereal *, ftnlen);
integer lwkopt; integer lwkopt;
h_dim1 = *ldh; h_dim1 = *ldh;
h_offset = 1 + h_dim1; h_offset = 1 + h_dim1;
@ -115,7 +114,6 @@ int dlaqr3_(logical *wantt, logical *wantz, integer *n, integer *ktop, integer *
} }
safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12); safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12);
safmax = 1. / safmin; safmax = 1. / safmin;
dlabad_(&safmin, &safmax);
ulp = dlamch_((char *)"PRECISION", (ftnlen)9); ulp = dlamch_((char *)"PRECISION", (ftnlen)9);
smlnum = safmin * ((doublereal)(*n) / ulp); smlnum = safmin * ((doublereal)(*n) / ulp);
i__1 = *nw, i__2 = *kbot - *ktop + 1; i__1 = *nw, i__2 = *kbot - *ktop + 1;
@ -299,14 +297,14 @@ L60:
dcopy_(ns, &v[v_offset], ldv, &work[1], &c__1); dcopy_(ns, &v[v_offset], ldv, &work[1], &c__1);
beta = work[1]; beta = work[1];
dlarfg_(ns, &beta, &work[2], &c__1, &tau); dlarfg_(ns, &beta, &work[2], &c__1, &tau);
work[1] = 1.;
i__1 = jw - 2; i__1 = jw - 2;
i__2 = jw - 2; i__2 = jw - 2;
dlaset_((char *)"L", &i__1, &i__2, &c_b17, &c_b17, &t[t_dim1 + 3], ldt, (ftnlen)1); dlaset_((char *)"L", &i__1, &i__2, &c_b17, &c_b17, &t[t_dim1 + 3], ldt, (ftnlen)1);
dlarf_((char *)"L", ns, &jw, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1], dlarf1f_((char *)"L", ns, &jw, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1],
(ftnlen)1); (ftnlen)1);
dlarf_((char *)"R", ns, ns, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1], (ftnlen)1); dlarf1f_((char *)"R", ns, ns, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1],
dlarf_((char *)"R", &jw, ns, &work[1], &c__1, &tau, &v[v_offset], ldv, &work[jw + 1], (ftnlen)1);
dlarf1f_((char *)"R", &jw, ns, &work[1], &c__1, &tau, &v[v_offset], ldv, &work[jw + 1],
(ftnlen)1); (ftnlen)1);
i__1 = *lwork - jw; i__1 = *lwork - jw;
dgehrd_(&jw, &c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1], &i__1, &info); dgehrd_(&jw, &c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1], &i__1, &info);

10
lib/linalg/dlaqr4.cpp
View File

@ -67,7 +67,7 @@ int dlaqr4_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
work[1] = 1.; work[1] = 1.;
return 0; return 0;
} }
if (*n <= 11) { if (*n <= 15) {
lwkopt = 1; lwkopt = 1;
if (*lwork != -1) { if (*lwork != -1) {
dlahqr_(wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], iloz, ihiz, dlahqr_(wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], iloz, ihiz,
@ -90,7 +90,7 @@ int dlaqr4_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1, i__2); i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1, i__2);
nwr = min(i__1, nwr); nwr = min(i__1, nwr);
nsr = ilaenv_(&c__15, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); nsr = ilaenv_(&c__15, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
i__1 = nsr, i__2 = (*n + 6) / 9, i__1 = min(i__1, i__2), i__2 = *ihi - *ilo; i__1 = nsr, i__2 = (*n - 3) / 6, i__1 = min(i__1, i__2), i__2 = *ihi - *ilo;
nsr = min(i__1, i__2); nsr = min(i__1, i__2);
i__1 = 2, i__2 = nsr - nsr % 2; i__1 = 2, i__2 = nsr - nsr % 2;
nsr = max(i__1, i__2); nsr = max(i__1, i__2);
@ -105,7 +105,7 @@ int dlaqr4_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
return 0; return 0;
} }
nmin = ilaenv_(&c__12, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); nmin = ilaenv_(&c__12, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
nmin = max(11, nmin); nmin = max(15, nmin);
nibble = ilaenv_(&c__14, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); nibble = ilaenv_(&c__14, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
nibble = max(0, nibble); nibble = max(0, nibble);
kacc22 = ilaenv_(&c__16, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2); kacc22 = ilaenv_(&c__16, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
@ -114,7 +114,7 @@ int dlaqr4_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
i__1 = (*n - 1) / 3, i__2 = *lwork / 2; i__1 = (*n - 1) / 3, i__2 = *lwork / 2;
nwmax = min(i__1, i__2); nwmax = min(i__1, i__2);
nw = nwmax; nw = nwmax;
i__1 = (*n + 6) / 9, i__2 = (*lwork << 1) / 3; i__1 = (*n - 3) / 6, i__2 = (*lwork << 1) / 3;
nsmax = min(i__1, i__2); nsmax = min(i__1, i__2);
nsmax -= nsmax % 2; nsmax -= nsmax % 2;
ndfl = 1; ndfl = 1;
@ -270,7 +270,7 @@ int dlaqr4_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i
ns = min(i__2, i__3); ns = min(i__2, i__3);
ns -= ns % 2; ns -= ns % 2;
ks = kbot - ns + 1; ks = kbot - ns + 1;
kdu = ns * 3 - 3; kdu = ns << 1;
ku = *n - kdu + 1; ku = *n - kdu + 1;
kwh = kdu + 1; kwh = kdu + 1;
nho = *n - kdu - 3 - (kdu + 1) + 1; nho = *n - kdu - 3 - (kdu + 1) + 1;

574
lib/linalg/dlaqr5.cpp
View File

@ -4,9 +4,9 @@ extern "C" {
#include "lmp_f2c.h" #include "lmp_f2c.h"
static doublereal c_b7 = 0.; static doublereal c_b7 = 0.;
static doublereal c_b8 = 1.; static doublereal c_b8 = 1.;
static integer c__3 = 3;
static integer c__1 = 1;
static integer c__2 = 2; static integer c__2 = 2;
static integer c__1 = 1;
static integer c__3 = 3;
int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer *ktop, int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer *ktop,
integer *kbot, integer *nshfts, doublereal *sr, doublereal *si, doublereal *h__, integer *kbot, integer *nshfts, doublereal *sr, doublereal *si, doublereal *h__,
integer *ldh, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz, integer *ldh, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz,
@ -16,16 +16,14 @@ int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer
integer h_dim1, h_offset, u_dim1, u_offset, v_dim1, v_offset, wh_dim1, wh_offset, wv_dim1, integer h_dim1, h_offset, u_dim1, u_offset, v_dim1, v_offset, wh_dim1, wh_offset, wv_dim1,
wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7;
doublereal d__1, d__2, d__3, d__4, d__5; doublereal d__1, d__2, d__3, d__4, d__5;
integer i__, j, k, m, i2, j2, i4, j4, k1; integer i__, j, k, m, i2, k1, i4;
doublereal h11, h12, h21, h22; doublereal t1, t2, t3, h11, h12, h21, h22;
integer m22, ns, nu; integer m22, ns, nu;
doublereal vt[3], scl; doublereal vt[3], scl;
integer kdu, kms; integer kdu, kms;
doublereal ulp; doublereal ulp, tst1, tst2, beta;
integer knz, kzs; logical bmp22;
doublereal tst1, tst2, beta; integer jcol, jlen, jbot, mbot;
logical blk22, bmp22;
integer mend, jcol, jlen, jbot, mbot;
doublereal swap; doublereal swap;
integer jtop, jrow, mtop; integer jtop, jrow, mtop;
doublereal alpha; doublereal alpha;
@ -34,12 +32,8 @@ int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer
integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *,
ftnlen, ftnlen); ftnlen, ftnlen);
integer ndcol, incol, krcol, nbmps; integer ndcol, incol, krcol, nbmps;
extern int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, extern int dlaqr1_(integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, doublereal *, integer *, ftnlen, ftnlen, ftnlen, doublereal *, doublereal *);
ftnlen),
dlaqr1_(integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *),
dlabad_(doublereal *, doublereal *);
extern doublereal dlamch_(char *, ftnlen); extern doublereal dlamch_(char *, ftnlen);
extern int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), extern int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *),
dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
@ -47,9 +41,7 @@ int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer
doublereal safmin; doublereal safmin;
extern int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, extern int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *,
integer *, ftnlen); integer *, ftnlen);
doublereal safmax, refsum; doublereal safmax, refsum, smlnum;
integer mstart;
doublereal smlnum;
--sr; --sr;
--si; --si;
h_dim1 = *ldh; h_dim1 = *ldh;
@ -92,42 +84,167 @@ int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer
ns = *nshfts - *nshfts % 2; ns = *nshfts - *nshfts % 2;
safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12); safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12);
safmax = 1. / safmin; safmax = 1. / safmin;
dlabad_(&safmin, &safmax);
ulp = dlamch_((char *)"PRECISION", (ftnlen)9); ulp = dlamch_((char *)"PRECISION", (ftnlen)9);
smlnum = safmin * ((doublereal)(*n) / ulp); smlnum = safmin * ((doublereal)(*n) / ulp);
accum = *kacc22 == 1 || *kacc22 == 2; accum = *kacc22 == 1 || *kacc22 == 2;
blk22 = ns > 2 && *kacc22 == 2;
if (*ktop + 2 <= *kbot) { if (*ktop + 2 <= *kbot) {
h__[*ktop + 2 + *ktop * h_dim1] = 0.; h__[*ktop + 2 + *ktop * h_dim1] = 0.;
} }
nbmps = ns / 2; nbmps = ns / 2;
kdu = nbmps * 6 - 3; kdu = nbmps << 2;
i__1 = *kbot - 2; i__1 = *kbot - 2;
i__2 = nbmps * 3 - 2; i__2 = nbmps << 1;
for (incol = (1 - nbmps) * 3 + *ktop - 1; i__2 < 0 ? incol >= i__1 : incol <= i__1; for (incol = *ktop - (nbmps << 1) + 1; i__2 < 0 ? incol >= i__1 : incol <= i__1;
incol += i__2) { incol += i__2) {
if (accum) {
jtop = max(*ktop, incol);
} else if (*wantt) {
jtop = 1;
} else {
jtop = *ktop;
}
ndcol = incol + kdu; ndcol = incol + kdu;
if (accum) { if (accum) {
dlaset_((char *)"ALL", &kdu, &kdu, &c_b7, &c_b8, &u[u_offset], ldu, (ftnlen)3); dlaset_((char *)"A", &kdu, &kdu, &c_b7, &c_b8, &u[u_offset], ldu, (ftnlen)1);
} }
i__4 = incol + nbmps * 3 - 3, i__5 = *kbot - 2; i__4 = incol + (nbmps << 1) - 1, i__5 = *kbot - 2;
i__3 = min(i__4, i__5); i__3 = min(i__4, i__5);
for (krcol = incol; krcol <= i__3; ++krcol) { for (krcol = incol; krcol <= i__3; ++krcol) {
i__4 = 1, i__5 = (*ktop - 1 - krcol + 2) / 3 + 1; i__4 = 1, i__5 = (*ktop - krcol) / 2 + 1;
mtop = max(i__4, i__5); mtop = max(i__4, i__5);
i__4 = nbmps, i__5 = (*kbot - krcol) / 3; i__4 = nbmps, i__5 = (*kbot - krcol - 1) / 2;
mbot = min(i__4, i__5); mbot = min(i__4, i__5);
m22 = mbot + 1; m22 = mbot + 1;
bmp22 = mbot < nbmps && krcol + (m22 - 1) * 3 == *kbot - 2; bmp22 = mbot < nbmps && krcol + (m22 - 1 << 1) == *kbot - 2;
i__4 = mbot; if (bmp22) {
for (m = mtop; m <= i__4; ++m) { k = krcol + (m22 - 1 << 1);
k = krcol + (m - 1) * 3; if (k == *ktop - 1) {
dlaqr1_(&c__2, &h__[k + 1 + (k + 1) * h_dim1], ldh, &sr[(m22 << 1) - 1],
&si[(m22 << 1) - 1], &sr[m22 * 2], &si[m22 * 2], &v[m22 * v_dim1 + 1]);
beta = v[m22 * v_dim1 + 1];
dlarfg_(&c__2, &beta, &v[m22 * v_dim1 + 2], &c__1, &v[m22 * v_dim1 + 1]);
} else {
beta = h__[k + 1 + k * h_dim1];
v[m22 * v_dim1 + 2] = h__[k + 2 + k * h_dim1];
dlarfg_(&c__2, &beta, &v[m22 * v_dim1 + 2], &c__1, &v[m22 * v_dim1 + 1]);
h__[k + 1 + k * h_dim1] = beta;
h__[k + 2 + k * h_dim1] = 0.;
}
t1 = v[m22 * v_dim1 + 1];
t2 = t1 * v[m22 * v_dim1 + 2];
i__5 = *kbot, i__6 = k + 3;
i__4 = min(i__5, i__6);
for (j = jtop; j <= i__4; ++j) {
refsum =
h__[j + (k + 1) * h_dim1] + v[m22 * v_dim1 + 2] * h__[j + (k + 2) * h_dim1];
h__[j + (k + 1) * h_dim1] -= refsum * t1;
h__[j + (k + 2) * h_dim1] -= refsum * t2;
}
if (accum) {
jbot = min(ndcol, *kbot);
} else if (*wantt) {
jbot = *n;
} else {
jbot = *kbot;
}
t1 = v[m22 * v_dim1 + 1];
t2 = t1 * v[m22 * v_dim1 + 2];
i__4 = jbot;
for (j = k + 1; j <= i__4; ++j) {
refsum =
h__[k + 1 + j * h_dim1] + v[m22 * v_dim1 + 2] * h__[k + 2 + j * h_dim1];
h__[k + 1 + j * h_dim1] -= refsum * t1;
h__[k + 2 + j * h_dim1] -= refsum * t2;
}
if (k >= *ktop) {
if (h__[k + 1 + k * h_dim1] != 0.) {
tst1 = (d__1 = h__[k + k * h_dim1], abs(d__1)) +
(d__2 = h__[k + 1 + (k + 1) * h_dim1], abs(d__2));
if (tst1 == 0.) {
if (k >= *ktop + 1) {
tst1 += (d__1 = h__[k + (k - 1) * h_dim1], abs(d__1));
}
if (k >= *ktop + 2) {
tst1 += (d__1 = h__[k + (k - 2) * h_dim1], abs(d__1));
}
if (k >= *ktop + 3) {
tst1 += (d__1 = h__[k + (k - 3) * h_dim1], abs(d__1));
}
if (k <= *kbot - 2) {
tst1 += (d__1 = h__[k + 2 + (k + 1) * h_dim1], abs(d__1));
}
if (k <= *kbot - 3) {
tst1 += (d__1 = h__[k + 3 + (k + 1) * h_dim1], abs(d__1));
}
if (k <= *kbot - 4) {
tst1 += (d__1 = h__[k + 4 + (k + 1) * h_dim1], abs(d__1));
}
}
d__2 = smlnum, d__3 = ulp * tst1;
if ((d__1 = h__[k + 1 + k * h_dim1], abs(d__1)) <= max(d__2, d__3)) {
d__3 = (d__1 = h__[k + 1 + k * h_dim1], abs(d__1)),
d__4 = (d__2 = h__[k + (k + 1) * h_dim1], abs(d__2));
h12 = max(d__3, d__4);
d__3 = (d__1 = h__[k + 1 + k * h_dim1], abs(d__1)),
d__4 = (d__2 = h__[k + (k + 1) * h_dim1], abs(d__2));
h21 = min(d__3, d__4);
d__3 = (d__1 = h__[k + 1 + (k + 1) * h_dim1], abs(d__1)),
d__4 = (d__2 = h__[k + k * h_dim1] - h__[k + 1 + (k + 1) * h_dim1],
abs(d__2));
h11 = max(d__3, d__4);
d__3 = (d__1 = h__[k + 1 + (k + 1) * h_dim1], abs(d__1)),
d__4 = (d__2 = h__[k + k * h_dim1] - h__[k + 1 + (k + 1) * h_dim1],
abs(d__2));
h22 = min(d__3, d__4);
scl = h11 + h12;
tst2 = h22 * (h11 / scl);
d__1 = smlnum, d__2 = ulp * tst2;
if (tst2 == 0. || h21 * (h12 / scl) <= max(d__1, d__2)) {
h__[k + 1 + k * h_dim1] = 0.;
}
}
}
}
if (accum) {
kms = k - incol;
t1 = v[m22 * v_dim1 + 1];
t2 = t1 * v[m22 * v_dim1 + 2];
i__4 = 1, i__5 = *ktop - incol;
i__6 = kdu;
for (j = max(i__4, i__5); j <= i__6; ++j) {
refsum = u[j + (kms + 1) * u_dim1] +
v[m22 * v_dim1 + 2] * u[j + (kms + 2) * u_dim1];
u[j + (kms + 1) * u_dim1] -= refsum * t1;
u[j + (kms + 2) * u_dim1] -= refsum * t2;
}
} else if (*wantz) {
t1 = v[m22 * v_dim1 + 1];
t2 = t1 * v[m22 * v_dim1 + 2];
i__6 = *ihiz;
for (j = *iloz; j <= i__6; ++j) {
refsum = z__[j + (k + 1) * z_dim1] +
v[m22 * v_dim1 + 2] * z__[j + (k + 2) * z_dim1];
z__[j + (k + 1) * z_dim1] -= refsum * t1;
z__[j + (k + 2) * z_dim1] -= refsum * t2;
}
}
}
i__6 = mtop;
for (m = mbot; m >= i__6; --m) {
k = krcol + (m - 1 << 1);
if (k == *ktop - 1) { if (k == *ktop - 1) {
dlaqr1_(&c__3, &h__[*ktop + *ktop * h_dim1], ldh, &sr[(m << 1) - 1], dlaqr1_(&c__3, &h__[*ktop + *ktop * h_dim1], ldh, &sr[(m << 1) - 1],
&si[(m << 1) - 1], &sr[m * 2], &si[m * 2], &v[m * v_dim1 + 1]); &si[(m << 1) - 1], &sr[m * 2], &si[m * 2], &v[m * v_dim1 + 1]);
alpha = v[m * v_dim1 + 1]; alpha = v[m * v_dim1 + 1];
dlarfg_(&c__3, &alpha, &v[m * v_dim1 + 2], &c__1, &v[m * v_dim1 + 1]); dlarfg_(&c__3, &alpha, &v[m * v_dim1 + 2], &c__1, &v[m * v_dim1 + 1]);
} else { } else {
t1 = v[m * v_dim1 + 1];
t2 = t1 * v[m * v_dim1 + 2];
t3 = t1 * v[m * v_dim1 + 3];
refsum = v[m * v_dim1 + 3] * h__[k + 3 + (k + 2) * h_dim1];
h__[k + 3 + k * h_dim1] = -refsum * t1;
h__[k + 3 + (k + 1) * h_dim1] = -refsum * t2;
h__[k + 3 + (k + 2) * h_dim1] -= refsum * t3;
beta = h__[k + 1 + k * h_dim1]; beta = h__[k + 1 + k * h_dim1];
v[m * v_dim1 + 2] = h__[k + 2 + k * h_dim1]; v[m * v_dim1 + 2] = h__[k + 2 + k * h_dim1];
v[m * v_dim1 + 3] = h__[k + 3 + k * h_dim1]; v[m * v_dim1 + 3] = h__[k + 3 + k * h_dim1];
@ -142,10 +259,12 @@ int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer
&si[(m << 1) - 1], &sr[m * 2], &si[m * 2], vt); &si[(m << 1) - 1], &sr[m * 2], &si[m * 2], vt);
alpha = vt[0]; alpha = vt[0];
dlarfg_(&c__3, &alpha, &vt[1], &c__1, vt); dlarfg_(&c__3, &alpha, &vt[1], &c__1, vt);
refsum = t1 = vt[0];
vt[0] * (h__[k + 1 + k * h_dim1] + vt[1] * h__[k + 2 + k * h_dim1]); t2 = t1 * vt[1];
if ((d__1 = h__[k + 2 + k * h_dim1] - refsum * vt[1], abs(d__1)) + t3 = t1 * vt[2];
(d__2 = refsum * vt[2], abs(d__2)) > refsum = h__[k + 1 + k * h_dim1] + vt[1] * h__[k + 2 + k * h_dim1];
if ((d__1 = h__[k + 2 + k * h_dim1] - refsum * t2, abs(d__1)) +
(d__2 = refsum * t3, abs(d__2)) >
ulp * ((d__3 = h__[k + k * h_dim1], abs(d__3)) + ulp * ((d__3 = h__[k + k * h_dim1], abs(d__3)) +
(d__4 = h__[k + 1 + (k + 1) * h_dim1], abs(d__4)) + (d__4 = h__[k + 1 + (k + 1) * h_dim1], abs(d__4)) +
(d__5 = h__[k + 2 + (k + 2) * h_dim1], abs(d__5)))) { (d__5 = h__[k + 2 + (k + 2) * h_dim1], abs(d__5)))) {
@ -153,7 +272,7 @@ int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer
h__[k + 2 + k * h_dim1] = 0.; h__[k + 2 + k * h_dim1] = 0.;
h__[k + 3 + k * h_dim1] = 0.; h__[k + 3 + k * h_dim1] = 0.;
} else { } else {
h__[k + 1 + k * h_dim1] -= refsum; h__[k + 1 + k * h_dim1] -= refsum * t1;
h__[k + 2 + k * h_dim1] = 0.; h__[k + 2 + k * h_dim1] = 0.;
h__[k + 3 + k * h_dim1] = 0.; h__[k + 3 + k * h_dim1] = 0.;
v[m * v_dim1 + 1] = vt[0]; v[m * v_dim1 + 1] = vt[0];
@ -162,154 +281,28 @@ int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer
} }
} }
} }
} t1 = v[m * v_dim1 + 1];
k = krcol + (m22 - 1) * 3; t2 = t1 * v[m * v_dim1 + 2];
if (bmp22) { t3 = t1 * v[m * v_dim1 + 3];
if (k == *ktop - 1) { i__5 = *kbot, i__7 = k + 3;
dlaqr1_(&c__2, &h__[k + 1 + (k + 1) * h_dim1], ldh, &sr[(m22 << 1) - 1], i__4 = min(i__5, i__7);
&si[(m22 << 1) - 1], &sr[m22 * 2], &si[m22 * 2], &v[m22 * v_dim1 + 1]);
beta = v[m22 * v_dim1 + 1];
dlarfg_(&c__2, &beta, &v[m22 * v_dim1 + 2], &c__1, &v[m22 * v_dim1 + 1]);
} else {
beta = h__[k + 1 + k * h_dim1];
v[m22 * v_dim1 + 2] = h__[k + 2 + k * h_dim1];
dlarfg_(&c__2, &beta, &v[m22 * v_dim1 + 2], &c__1, &v[m22 * v_dim1 + 1]);
h__[k + 1 + k * h_dim1] = beta;
h__[k + 2 + k * h_dim1] = 0.;
}
}
if (accum) {
jbot = min(ndcol, *kbot);
} else if (*wantt) {
jbot = *n;
} else {
jbot = *kbot;
}
i__4 = jbot;
for (j = max(*ktop, krcol); j <= i__4; ++j) {
i__5 = mbot, i__6 = (j - krcol + 2) / 3;
mend = min(i__5, i__6);
i__5 = mend;
for (m = mtop; m <= i__5; ++m) {
k = krcol + (m - 1) * 3;
refsum = v[m * v_dim1 + 1] * (h__[k + 1 + j * h_dim1] +
v[m * v_dim1 + 2] * h__[k + 2 + j * h_dim1] +
v[m * v_dim1 + 3] * h__[k + 3 + j * h_dim1]);
h__[k + 1 + j * h_dim1] -= refsum;
h__[k + 2 + j * h_dim1] -= refsum * v[m * v_dim1 + 2];
h__[k + 3 + j * h_dim1] -= refsum * v[m * v_dim1 + 3];
}
}
if (bmp22) {
k = krcol + (m22 - 1) * 3;
i__4 = k + 1;
i__5 = jbot;
for (j = max(i__4, *ktop); j <= i__5; ++j) {
refsum = v[m22 * v_dim1 + 1] * (h__[k + 1 + j * h_dim1] +
v[m22 * v_dim1 + 2] * h__[k + 2 + j * h_dim1]);
h__[k + 1 + j * h_dim1] -= refsum;
h__[k + 2 + j * h_dim1] -= refsum * v[m22 * v_dim1 + 2];
}
}
if (accum) {
jtop = max(*ktop, incol);
} else if (*wantt) {
jtop = 1;
} else {
jtop = *ktop;
}
i__5 = mbot;
for (m = mtop; m <= i__5; ++m) {
if (v[m * v_dim1 + 1] != 0.) {
k = krcol + (m - 1) * 3;
i__6 = *kbot, i__7 = k + 3;
i__4 = min(i__6, i__7);
for (j = jtop; j <= i__4; ++j) { for (j = jtop; j <= i__4; ++j) {
refsum = refsum = h__[j + (k + 1) * h_dim1] +
v[m * v_dim1 + 1] * (h__[j + (k + 1) * h_dim1] +
v[m * v_dim1 + 2] * h__[j + (k + 2) * h_dim1] + v[m * v_dim1 + 2] * h__[j + (k + 2) * h_dim1] +
v[m * v_dim1 + 3] * h__[j + (k + 3) * h_dim1]); v[m * v_dim1 + 3] * h__[j + (k + 3) * h_dim1];
h__[j + (k + 1) * h_dim1] -= refsum; h__[j + (k + 1) * h_dim1] -= refsum * t1;
h__[j + (k + 2) * h_dim1] -= refsum * v[m * v_dim1 + 2]; h__[j + (k + 2) * h_dim1] -= refsum * t2;
h__[j + (k + 3) * h_dim1] -= refsum * v[m * v_dim1 + 3]; h__[j + (k + 3) * h_dim1] -= refsum * t3;
} }
if (accum) { refsum = h__[k + 1 + (k + 1) * h_dim1] +
kms = k - incol; v[m * v_dim1 + 2] * h__[k + 2 + (k + 1) * h_dim1] +
i__4 = 1, i__6 = *ktop - incol; v[m * v_dim1 + 3] * h__[k + 3 + (k + 1) * h_dim1];
i__7 = kdu; h__[k + 1 + (k + 1) * h_dim1] -= refsum * t1;
for (j = max(i__4, i__6); j <= i__7; ++j) { h__[k + 2 + (k + 1) * h_dim1] -= refsum * t2;
refsum = h__[k + 3 + (k + 1) * h_dim1] -= refsum * t3;
v[m * v_dim1 + 1] * (u[j + (kms + 1) * u_dim1] + if (k < *ktop) {
v[m * v_dim1 + 2] * u[j + (kms + 2) * u_dim1] + goto L85;
v[m * v_dim1 + 3] * u[j + (kms + 3) * u_dim1]);
u[j + (kms + 1) * u_dim1] -= refsum;
u[j + (kms + 2) * u_dim1] -= refsum * v[m * v_dim1 + 2];
u[j + (kms + 3) * u_dim1] -= refsum * v[m * v_dim1 + 3];
} }
} else if (*wantz) {
i__7 = *ihiz;
for (j = *iloz; j <= i__7; ++j) {
refsum =
v[m * v_dim1 + 1] * (z__[j + (k + 1) * z_dim1] +
v[m * v_dim1 + 2] * z__[j + (k + 2) * z_dim1] +
v[m * v_dim1 + 3] * z__[j + (k + 3) * z_dim1]);
z__[j + (k + 1) * z_dim1] -= refsum;
z__[j + (k + 2) * z_dim1] -= refsum * v[m * v_dim1 + 2];
z__[j + (k + 3) * z_dim1] -= refsum * v[m * v_dim1 + 3];
}
}
}
}
k = krcol + (m22 - 1) * 3;
if (bmp22) {
if (v[m22 * v_dim1 + 1] != 0.) {
i__7 = *kbot, i__4 = k + 3;
i__5 = min(i__7, i__4);
for (j = jtop; j <= i__5; ++j) {
refsum =
v[m22 * v_dim1 + 1] * (h__[j + (k + 1) * h_dim1] +
v[m22 * v_dim1 + 2] * h__[j + (k + 2) * h_dim1]);
h__[j + (k + 1) * h_dim1] -= refsum;
h__[j + (k + 2) * h_dim1] -= refsum * v[m22 * v_dim1 + 2];
}
if (accum) {
kms = k - incol;
i__5 = 1, i__7 = *ktop - incol;
i__4 = kdu;
for (j = max(i__5, i__7); j <= i__4; ++j) {
refsum = v[m22 * v_dim1 + 1] *
(u[j + (kms + 1) * u_dim1] +
v[m22 * v_dim1 + 2] * u[j + (kms + 2) * u_dim1]);
u[j + (kms + 1) * u_dim1] -= refsum;
u[j + (kms + 2) * u_dim1] -= refsum * v[m22 * v_dim1 + 2];
}
} else if (*wantz) {
i__4 = *ihiz;
for (j = *iloz; j <= i__4; ++j) {
refsum = v[m22 * v_dim1 + 1] *
(z__[j + (k + 1) * z_dim1] +
v[m22 * v_dim1 + 2] * z__[j + (k + 2) * z_dim1]);
z__[j + (k + 1) * z_dim1] -= refsum;
z__[j + (k + 2) * z_dim1] -= refsum * v[m22 * v_dim1 + 2];
}
}
}
}
mstart = mtop;
if (krcol + (mstart - 1) * 3 < *ktop) {
++mstart;
}
mend = mbot;
if (bmp22) {
++mend;
}
if (krcol == *kbot - 2) {
++mend;
}
i__4 = mend;
for (m = mstart; m <= i__4; ++m) {
i__5 = *kbot - 1, i__7 = krcol + (m - 1) * 3;
k = min(i__5, i__7);
if (h__[k + 1 + k * h_dim1] != 0.) { if (h__[k + 1 + k * h_dim1] != 0.) {
tst1 = (d__1 = h__[k + k * h_dim1], abs(d__1)) + tst1 = (d__1 = h__[k + k * h_dim1], abs(d__1)) +
(d__2 = h__[k + 1 + (k + 1) * h_dim1], abs(d__2)); (d__2 = h__[k + 1 + (k + 1) * h_dim1], abs(d__2));
@ -357,16 +350,72 @@ int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer
} }
} }
} }
L85:;
}
if (accum) {
jbot = min(ndcol, *kbot);
} else if (*wantt) {
jbot = *n;
} else {
jbot = *kbot;
}
i__6 = mtop;
for (m = mbot; m >= i__6; --m) {
k = krcol + (m - 1 << 1);
t1 = v[m * v_dim1 + 1];
t2 = t1 * v[m * v_dim1 + 2];
t3 = t1 * v[m * v_dim1 + 3];
i__4 = *ktop, i__5 = krcol + (m << 1);
i__7 = jbot;
for (j = max(i__4, i__5); j <= i__7; ++j) {
refsum = h__[k + 1 + j * h_dim1] + v[m * v_dim1 + 2] * h__[k + 2 + j * h_dim1] +
v[m * v_dim1 + 3] * h__[k + 3 + j * h_dim1];
h__[k + 1 + j * h_dim1] -= refsum * t1;
h__[k + 2 + j * h_dim1] -= refsum * t2;
h__[k + 3 + j * h_dim1] -= refsum * t3;
}
}
if (accum) {
i__6 = mtop;
for (m = mbot; m >= i__6; --m) {
k = krcol + (m - 1 << 1);
kms = k - incol;
i__7 = 1, i__4 = *ktop - incol;
i2 = max(i__7, i__4);
i__7 = i2, i__4 = kms - (krcol - incol) + 1;
i2 = max(i__7, i__4);
i__7 = kdu, i__4 = krcol + (mbot - 1 << 1) - incol + 5;
i4 = min(i__7, i__4);
t1 = v[m * v_dim1 + 1];
t2 = t1 * v[m * v_dim1 + 2];
t3 = t1 * v[m * v_dim1 + 3];
i__7 = i4;
for (j = i2; j <= i__7; ++j) {
refsum = u[j + (kms + 1) * u_dim1] +
v[m * v_dim1 + 2] * u[j + (kms + 2) * u_dim1] +
v[m * v_dim1 + 3] * u[j + (kms + 3) * u_dim1];
u[j + (kms + 1) * u_dim1] -= refsum * t1;
u[j + (kms + 2) * u_dim1] -= refsum * t2;
u[j + (kms + 3) * u_dim1] -= refsum * t3;
}
}
} else if (*wantz) {
i__6 = mtop;
for (m = mbot; m >= i__6; --m) {
k = krcol + (m - 1 << 1);
t1 = v[m * v_dim1 + 1];
t2 = t1 * v[m * v_dim1 + 2];
t3 = t1 * v[m * v_dim1 + 3];
i__7 = *ihiz;
for (j = *iloz; j <= i__7; ++j) {
refsum = z__[j + (k + 1) * z_dim1] +
v[m * v_dim1 + 2] * z__[j + (k + 2) * z_dim1] +
v[m * v_dim1 + 3] * z__[j + (k + 3) * z_dim1];
z__[j + (k + 1) * z_dim1] -= refsum * t1;
z__[j + (k + 2) * z_dim1] -= refsum * t2;
z__[j + (k + 3) * z_dim1] -= refsum * t3;
}
} }
i__4 = nbmps, i__5 = (*kbot - krcol - 1) / 3;
mend = min(i__4, i__5);
i__4 = mend;
for (m = mtop; m <= i__4; ++m) {
k = krcol + (m - 1) * 3;
refsum = v[m * v_dim1 + 1] * v[m * v_dim1 + 3] * h__[k + 4 + (k + 3) * h_dim1];
h__[k + 4 + (k + 1) * h_dim1] = -refsum;
h__[k + 4 + (k + 2) * h_dim1] = -refsum * v[m * v_dim1 + 2];
h__[k + 4 + (k + 3) * h_dim1] -= refsum * v[m * v_dim1 + 3];
} }
} }
if (accum) { if (accum) {
@ -377,139 +426,44 @@ int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer
jtop = *ktop; jtop = *ktop;
jbot = *kbot; jbot = *kbot;
} }
if (!blk22 || incol < *ktop || ndcol > *kbot || ns <= 2) { i__3 = 1, i__6 = *ktop - incol;
i__3 = 1, i__4 = *ktop - incol; k1 = max(i__3, i__6);
k1 = max(i__3, i__4); i__3 = 0, i__6 = ndcol - *kbot;
i__3 = 0, i__4 = ndcol - *kbot; nu = kdu - max(i__3, i__6) - k1 + 1;
nu = kdu - max(i__3, i__4) - k1 + 1;
i__3 = jbot; i__3 = jbot;
i__4 = *nh; i__6 = *nh;
for (jcol = min(ndcol, *kbot) + 1; i__4 < 0 ? jcol >= i__3 : jcol <= i__3; for (jcol = min(ndcol, *kbot) + 1; i__6 < 0 ? jcol >= i__3 : jcol <= i__3;
jcol += i__4) { jcol += i__6) {
i__5 = *nh, i__7 = jbot - jcol + 1; i__7 = *nh, i__4 = jbot - jcol + 1;
jlen = min(i__5, i__7); jlen = min(i__7, i__4);
dgemm_((char *)"C", (char *)"N", &nu, &jlen, &nu, &c_b8, &u[k1 + k1 * u_dim1], ldu, dgemm_((char *)"C", (char *)"N", &nu, &jlen, &nu, &c_b8, &u[k1 + k1 * u_dim1], ldu,
&h__[incol + k1 + jcol * h_dim1], ldh, &c_b7, &wh[wh_offset], ldwh, &h__[incol + k1 + jcol * h_dim1], ldh, &c_b7, &wh[wh_offset], ldwh,
(ftnlen)1, (ftnlen)1); (ftnlen)1, (ftnlen)1);
dlacpy_((char *)"ALL", &nu, &jlen, &wh[wh_offset], ldwh, dlacpy_((char *)"A", &nu, &jlen, &wh[wh_offset], ldwh, &h__[incol + k1 + jcol * h_dim1],
&h__[incol + k1 + jcol * h_dim1], ldh, (ftnlen)3); ldh, (ftnlen)1);
} }
i__4 = max(*ktop, incol) - 1; i__6 = max(*ktop, incol) - 1;
i__3 = *nv; i__3 = *nv;
for (jrow = jtop; i__3 < 0 ? jrow >= i__4 : jrow <= i__4; jrow += i__3) { for (jrow = jtop; i__3 < 0 ? jrow >= i__6 : jrow <= i__6; jrow += i__3) {
i__5 = *nv, i__7 = max(*ktop, incol) - jrow; i__7 = *nv, i__4 = max(*ktop, incol) - jrow;
jlen = min(i__5, i__7); jlen = min(i__7, i__4);
dgemm_((char *)"N", (char *)"N", &jlen, &nu, &nu, &c_b8, &h__[jrow + (incol + k1) * h_dim1], dgemm_((char *)"N", (char *)"N", &jlen, &nu, &nu, &c_b8, &h__[jrow + (incol + k1) * h_dim1], ldh,
ldh, &u[k1 + k1 * u_dim1], ldu, &c_b7, &wv[wv_offset], ldwv, (ftnlen)1, &u[k1 + k1 * u_dim1], ldu, &c_b7, &wv[wv_offset], ldwv, (ftnlen)1,
(ftnlen)1); (ftnlen)1);
dlacpy_((char *)"ALL", &jlen, &nu, &wv[wv_offset], ldwv, dlacpy_((char *)"A", &jlen, &nu, &wv[wv_offset], ldwv, &h__[jrow + (incol + k1) * h_dim1],
&h__[jrow + (incol + k1) * h_dim1], ldh, (ftnlen)3); ldh, (ftnlen)1);
} }
if (*wantz) { if (*wantz) {
i__3 = *ihiz; i__3 = *ihiz;
i__4 = *nv; i__6 = *nv;
for (jrow = *iloz; i__4 < 0 ? jrow >= i__3 : jrow <= i__3; jrow += i__4) { for (jrow = *iloz; i__6 < 0 ? jrow >= i__3 : jrow <= i__3; jrow += i__6) {
i__5 = *nv, i__7 = *ihiz - jrow + 1; i__7 = *nv, i__4 = *ihiz - jrow + 1;
jlen = min(i__5, i__7); jlen = min(i__7, i__4);
dgemm_((char *)"N", (char *)"N", &jlen, &nu, &nu, &c_b8, &z__[jrow + (incol + k1) * z_dim1], dgemm_((char *)"N", (char *)"N", &jlen, &nu, &nu, &c_b8, &z__[jrow + (incol + k1) * z_dim1],
ldz, &u[k1 + k1 * u_dim1], ldu, &c_b7, &wv[wv_offset], ldwv, ldz, &u[k1 + k1 * u_dim1], ldu, &c_b7, &wv[wv_offset], ldwv, (ftnlen)1,
(ftnlen)1, (ftnlen)1);
dlacpy_((char *)"ALL", &jlen, &nu, &wv[wv_offset], ldwv,
&z__[jrow + (incol + k1) * z_dim1], ldz, (ftnlen)3);
}
}
} else {
i2 = (kdu + 1) / 2;
i4 = kdu;
j2 = i4 - i2;
j4 = kdu;
kzs = j4 - j2 - (ns + 1);
knz = ns + 1;
i__4 = jbot;
i__3 = *nh;
for (jcol = min(ndcol, *kbot) + 1; i__3 < 0 ? jcol >= i__4 : jcol <= i__4;
jcol += i__3) {
i__5 = *nh, i__7 = jbot - jcol + 1;
jlen = min(i__5, i__7);
dlacpy_((char *)"ALL", &knz, &jlen, &h__[incol + 1 + j2 + jcol * h_dim1], ldh,
&wh[kzs + 1 + wh_dim1], ldwh, (ftnlen)3);
dlaset_((char *)"ALL", &kzs, &jlen, &c_b7, &c_b7, &wh[wh_offset], ldwh, (ftnlen)3);
dtrmm_((char *)"L", (char *)"U", (char *)"C", (char *)"N", &knz, &jlen, &c_b8, &u[j2 + 1 + (kzs + 1) * u_dim1],
ldu, &wh[kzs + 1 + wh_dim1], ldwh, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)1); (ftnlen)1);
dgemm_((char *)"C", (char *)"N", &i2, &jlen, &j2, &c_b8, &u[u_offset], ldu, dlacpy_((char *)"A", &jlen, &nu, &wv[wv_offset], ldwv,
&h__[incol + 1 + jcol * h_dim1], ldh, &c_b8, &wh[wh_offset], ldwh, &z__[jrow + (incol + k1) * z_dim1], ldz, (ftnlen)1);
(ftnlen)1, (ftnlen)1);
dlacpy_((char *)"ALL", &j2, &jlen, &h__[incol + 1 + jcol * h_dim1], ldh,
&wh[i2 + 1 + wh_dim1], ldwh, (ftnlen)3);
dtrmm_((char *)"L", (char *)"L", (char *)"C", (char *)"N", &j2, &jlen, &c_b8, &u[(i2 + 1) * u_dim1 + 1], ldu,
&wh[i2 + 1 + wh_dim1], ldwh, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__5 = i4 - i2;
i__7 = j4 - j2;
dgemm_((char *)"C", (char *)"N", &i__5, &jlen, &i__7, &c_b8, &u[j2 + 1 + (i2 + 1) * u_dim1],
ldu, &h__[incol + 1 + j2 + jcol * h_dim1], ldh, &c_b8,
&wh[i2 + 1 + wh_dim1], ldwh, (ftnlen)1, (ftnlen)1);
dlacpy_((char *)"ALL", &kdu, &jlen, &wh[wh_offset], ldwh,
&h__[incol + 1 + jcol * h_dim1], ldh, (ftnlen)3);
}
i__3 = max(incol, *ktop) - 1;
i__4 = *nv;
for (jrow = jtop; i__4 < 0 ? jrow >= i__3 : jrow <= i__3; jrow += i__4) {
i__5 = *nv, i__7 = max(incol, *ktop) - jrow;
jlen = min(i__5, i__7);
dlacpy_((char *)"ALL", &jlen, &knz, &h__[jrow + (incol + 1 + j2) * h_dim1], ldh,
&wv[(kzs + 1) * wv_dim1 + 1], ldwv, (ftnlen)3);
dlaset_((char *)"ALL", &jlen, &kzs, &c_b7, &c_b7, &wv[wv_offset], ldwv, (ftnlen)3);
dtrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"N", &jlen, &knz, &c_b8, &u[j2 + 1 + (kzs + 1) * u_dim1],
ldu, &wv[(kzs + 1) * wv_dim1 + 1], ldwv, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)1);
dgemm_((char *)"N", (char *)"N", &jlen, &i2, &j2, &c_b8, &h__[jrow + (incol + 1) * h_dim1], ldh,
&u[u_offset], ldu, &c_b8, &wv[wv_offset], ldwv, (ftnlen)1, (ftnlen)1);
dlacpy_((char *)"ALL", &jlen, &j2, &h__[jrow + (incol + 1) * h_dim1], ldh,
&wv[(i2 + 1) * wv_dim1 + 1], ldwv, (ftnlen)3);
i__5 = i4 - i2;
dtrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"N", &jlen, &i__5, &c_b8, &u[(i2 + 1) * u_dim1 + 1], ldu,
&wv[(i2 + 1) * wv_dim1 + 1], ldwv, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)1);
i__5 = i4 - i2;
i__7 = j4 - j2;
dgemm_((char *)"N", (char *)"N", &jlen, &i__5, &i__7, &c_b8,
&h__[jrow + (incol + 1 + j2) * h_dim1], ldh,
&u[j2 + 1 + (i2 + 1) * u_dim1], ldu, &c_b8, &wv[(i2 + 1) * wv_dim1 + 1],
ldwv, (ftnlen)1, (ftnlen)1);
dlacpy_((char *)"ALL", &jlen, &kdu, &wv[wv_offset], ldwv,
&h__[jrow + (incol + 1) * h_dim1], ldh, (ftnlen)3);
}
if (*wantz) {
i__4 = *ihiz;
i__3 = *nv;
for (jrow = *iloz; i__3 < 0 ? jrow >= i__4 : jrow <= i__4; jrow += i__3) {
i__5 = *nv, i__7 = *ihiz - jrow + 1;
jlen = min(i__5, i__7);
dlacpy_((char *)"ALL", &jlen, &knz, &z__[jrow + (incol + 1 + j2) * z_dim1], ldz,
&wv[(kzs + 1) * wv_dim1 + 1], ldwv, (ftnlen)3);
dlaset_((char *)"ALL", &jlen, &kzs, &c_b7, &c_b7, &wv[wv_offset], ldwv, (ftnlen)3);
dtrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"N", &jlen, &knz, &c_b8,
&u[j2 + 1 + (kzs + 1) * u_dim1], ldu, &wv[(kzs + 1) * wv_dim1 + 1],
ldwv, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
dgemm_((char *)"N", (char *)"N", &jlen, &i2, &j2, &c_b8, &z__[jrow + (incol + 1) * z_dim1],
ldz, &u[u_offset], ldu, &c_b8, &wv[wv_offset], ldwv, (ftnlen)1,
(ftnlen)1);
dlacpy_((char *)"ALL", &jlen, &j2, &z__[jrow + (incol + 1) * z_dim1], ldz,
&wv[(i2 + 1) * wv_dim1 + 1], ldwv, (ftnlen)3);
i__5 = i4 - i2;
dtrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"N", &jlen, &i__5, &c_b8, &u[(i2 + 1) * u_dim1 + 1],
ldu, &wv[(i2 + 1) * wv_dim1 + 1], ldwv, (ftnlen)1, (ftnlen)1,
(ftnlen)1, (ftnlen)1);
i__5 = i4 - i2;
i__7 = j4 - j2;
dgemm_((char *)"N", (char *)"N", &jlen, &i__5, &i__7, &c_b8,
&z__[jrow + (incol + 1 + j2) * z_dim1], ldz,
&u[j2 + 1 + (i2 + 1) * u_dim1], ldu, &c_b8,
&wv[(i2 + 1) * wv_dim1 + 1], ldwv, (ftnlen)1, (ftnlen)1);
dlacpy_((char *)"ALL", &jlen, &kdu, &wv[wv_offset], ldwv,
&z__[jrow + (incol + 1) * z_dim1], ldz, (ftnlen)3);
}
} }
} }
} }

8
lib/linalg/dlarf.cpp
View File

@ -51,15 +51,15 @@ int dlarf_(char *side, integer *m, integer *n, doublereal *v, integer *incv, dou
} }
if (applyleft) { if (applyleft) {
if (lastv > 0) { if (lastv > 0) {
dgemv_((char *)"Transpose", &lastv, &lastc, &c_b4, &c__[c_offset], ldc, &v[1], incv, &c_b5, dgemv_((char *)"T", &lastv, &lastc, &c_b4, &c__[c_offset], ldc, &v[1], incv, &c_b5, &work[1],
&work[1], &c__1, (ftnlen)9); &c__1, (ftnlen)1);
d__1 = -(*tau); d__1 = -(*tau);
dger_(&lastv, &lastc, &d__1, &v[1], incv, &work[1], &c__1, &c__[c_offset], ldc); dger_(&lastv, &lastc, &d__1, &v[1], incv, &work[1], &c__1, &c__[c_offset], ldc);
} }
} else { } else {
if (lastv > 0) { if (lastv > 0) {
dgemv_((char *)"No transpose", &lastc, &lastv, &c_b4, &c__[c_offset], ldc, &v[1], incv, &c_b5, dgemv_((char *)"N", &lastc, &lastv, &c_b4, &c__[c_offset], ldc, &v[1], incv, &c_b5, &work[1],
&work[1], &c__1, (ftnlen)12); &c__1, (ftnlen)1);
d__1 = -(*tau); d__1 = -(*tau);
dger_(&lastc, &lastv, &d__1, &work[1], &c__1, &v[1], incv, &c__[c_offset], ldc); dger_(&lastc, &lastv, &d__1, &work[1], &c__1, &v[1], incv, &c__[c_offset], ldc);
} }

192
lib/linalg/dlarfb.cpp
View File

@ -48,24 +48,24 @@ int dlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
dcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); dcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1);
} }
dtrmm_((char *)"Right", (char *)"Lower", (char *)"No transpose", (char *)"Unit", n, k, &c_b14, &v[v_offset], ldv, dtrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"U", n, k, &c_b14, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
dgemm_((char *)"Transpose", (char *)"No transpose", n, k, &i__1, &c_b14, &c__[*k + 1 + c_dim1], dgemm_((char *)"T", (char *)"N", n, k, &i__1, &c_b14, &c__[*k + 1 + c_dim1], ldc,
ldc, &v[*k + 1 + v_dim1], ldv, &c_b14, &work[work_offset], ldwork, &v[*k + 1 + v_dim1], ldv, &c_b14, &work[work_offset], ldwork, (ftnlen)1,
(ftnlen)9, (ftnlen)12); (ftnlen)1);
} }
dtrmm_((char *)"Right", (char *)"Upper", transt, (char *)"Non-unit", n, k, &c_b14, &t[t_offset], ldt, dtrmm_((char *)"R", (char *)"U", transt, (char *)"N", n, k, &c_b14, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
dgemm_((char *)"No transpose", (char *)"Transpose", &i__1, n, k, &c_b25, &v[*k + 1 + v_dim1], dgemm_((char *)"N", (char *)"T", &i__1, n, k, &c_b25, &v[*k + 1 + v_dim1], ldv,
ldv, &work[work_offset], ldwork, &c_b14, &c__[*k + 1 + c_dim1], ldc, &work[work_offset], ldwork, &c_b14, &c__[*k + 1 + c_dim1], ldc,
(ftnlen)12, (ftnlen)9); (ftnlen)1, (ftnlen)1);
} }
dtrmm_((char *)"Right", (char *)"Lower", (char *)"Transpose", (char *)"Unit", n, k, &c_b14, &v[v_offset], ldv, dtrmm_((char *)"R", (char *)"L", (char *)"T", (char *)"U", n, k, &c_b14, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)9, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *n; i__2 = *n;
@ -78,24 +78,24 @@ int dlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
dcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], &c__1); dcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], &c__1);
} }
dtrmm_((char *)"Right", (char *)"Lower", (char *)"No transpose", (char *)"Unit", m, k, &c_b14, &v[v_offset], ldv, dtrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"U", m, k, &c_b14, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
dgemm_((char *)"No transpose", (char *)"No transpose", m, k, &i__1, &c_b14, dgemm_((char *)"N", (char *)"N", m, k, &i__1, &c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc,
&c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k + 1 + v_dim1], ldv, &c_b14, &v[*k + 1 + v_dim1], ldv, &c_b14, &work[work_offset], ldwork, (ftnlen)1,
&work[work_offset], ldwork, (ftnlen)12, (ftnlen)12); (ftnlen)1);
} }
dtrmm_((char *)"Right", (char *)"Upper", trans, (char *)"Non-unit", m, k, &c_b14, &t[t_offset], ldt, dtrmm_((char *)"R", (char *)"U", trans, (char *)"N", m, k, &c_b14, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
dgemm_((char *)"No transpose", (char *)"Transpose", m, &i__1, k, &c_b25, &work[work_offset], dgemm_((char *)"N", (char *)"T", m, &i__1, k, &c_b25, &work[work_offset], ldwork,
ldwork, &v[*k + 1 + v_dim1], ldv, &c_b14, &c__[(*k + 1) * c_dim1 + 1], &v[*k + 1 + v_dim1], ldv, &c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc,
ldc, (ftnlen)12, (ftnlen)9); (ftnlen)1, (ftnlen)1);
} }
dtrmm_((char *)"Right", (char *)"Lower", (char *)"Transpose", (char *)"Unit", m, k, &c_b14, &v[v_offset], ldv, dtrmm_((char *)"R", (char *)"L", (char *)"T", (char *)"U", m, k, &c_b14, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)9, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *m; i__2 = *m;
@ -110,26 +110,22 @@ int dlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
dcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); dcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1);
} }
dtrmm_((char *)"Right", (char *)"Upper", (char *)"No transpose", (char *)"Unit", n, k, &c_b14, dtrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"U", n, k, &c_b14, &v[*m - *k + 1 + v_dim1], ldv,
&v[*m - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12, (ftnlen)4);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
dgemm_((char *)"Transpose", (char *)"No transpose", n, k, &i__1, &c_b14, &c__[c_offset], ldc, dgemm_((char *)"T", (char *)"N", n, k, &i__1, &c_b14, &c__[c_offset], ldc, &v[v_offset], ldv,
&v[v_offset], ldv, &c_b14, &work[work_offset], ldwork, (ftnlen)9, &c_b14, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1);
(ftnlen)12);
} }
dtrmm_((char *)"Right", (char *)"Lower", transt, (char *)"Non-unit", n, k, &c_b14, &t[t_offset], ldt, dtrmm_((char *)"R", (char *)"L", transt, (char *)"N", n, k, &c_b14, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
dgemm_((char *)"No transpose", (char *)"Transpose", &i__1, n, k, &c_b25, &v[v_offset], ldv, dgemm_((char *)"N", (char *)"T", &i__1, n, k, &c_b25, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, &c_b14, &c__[c_offset], ldc, (ftnlen)12, ldwork, &c_b14, &c__[c_offset], ldc, (ftnlen)1, (ftnlen)1);
(ftnlen)9);
} }
dtrmm_((char *)"Right", (char *)"Upper", (char *)"Transpose", (char *)"Unit", n, k, &c_b14, dtrmm_((char *)"R", (char *)"U", (char *)"T", (char *)"U", n, k, &c_b14, &v[*m - *k + 1 + v_dim1], ldv,
&v[*m - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)9, (ftnlen)4);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *n; i__2 = *n;
@ -143,26 +139,22 @@ int dlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
dcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], dcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1],
&c__1); &c__1);
} }
dtrmm_((char *)"Right", (char *)"Upper", (char *)"No transpose", (char *)"Unit", m, k, &c_b14, dtrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"U", m, k, &c_b14, &v[*n - *k + 1 + v_dim1], ldv,
&v[*n - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12, (ftnlen)4);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
dgemm_((char *)"No transpose", (char *)"No transpose", m, k, &i__1, &c_b14, &c__[c_offset], ldc, dgemm_((char *)"N", (char *)"N", m, k, &i__1, &c_b14, &c__[c_offset], ldc, &v[v_offset], ldv,
&v[v_offset], ldv, &c_b14, &work[work_offset], ldwork, (ftnlen)12, &c_b14, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1);
(ftnlen)12);
} }
dtrmm_((char *)"Right", (char *)"Lower", trans, (char *)"Non-unit", m, k, &c_b14, &t[t_offset], ldt, dtrmm_((char *)"R", (char *)"L", trans, (char *)"N", m, k, &c_b14, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
dgemm_((char *)"No transpose", (char *)"Transpose", m, &i__1, k, &c_b25, &work[work_offset], dgemm_((char *)"N", (char *)"T", m, &i__1, k, &c_b25, &work[work_offset], ldwork, &v[v_offset],
ldwork, &v[v_offset], ldv, &c_b14, &c__[c_offset], ldc, (ftnlen)12, ldv, &c_b14, &c__[c_offset], ldc, (ftnlen)1, (ftnlen)1);
(ftnlen)9);
} }
dtrmm_((char *)"Right", (char *)"Upper", (char *)"Transpose", (char *)"Unit", m, k, &c_b14, dtrmm_((char *)"R", (char *)"U", (char *)"T", (char *)"U", m, k, &c_b14, &v[*n - *k + 1 + v_dim1], ldv,
&v[*n - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)9, (ftnlen)4);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *m; i__2 = *m;
@ -179,24 +171,24 @@ int dlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
dcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); dcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1);
} }
dtrmm_((char *)"Right", (char *)"Upper", (char *)"Transpose", (char *)"Unit", n, k, &c_b14, &v[v_offset], ldv, dtrmm_((char *)"R", (char *)"U", (char *)"T", (char *)"U", n, k, &c_b14, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)9, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
dgemm_((char *)"Transpose", (char *)"Transpose", n, k, &i__1, &c_b14, &c__[*k + 1 + c_dim1], dgemm_((char *)"T", (char *)"T", n, k, &i__1, &c_b14, &c__[*k + 1 + c_dim1], ldc,
ldc, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b14, &work[work_offset], ldwork, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b14, &work[work_offset], ldwork,
(ftnlen)9, (ftnlen)9); (ftnlen)1, (ftnlen)1);
} }
dtrmm_((char *)"Right", (char *)"Upper", transt, (char *)"Non-unit", n, k, &c_b14, &t[t_offset], ldt, dtrmm_((char *)"R", (char *)"U", transt, (char *)"N", n, k, &c_b14, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
dgemm_((char *)"Transpose", (char *)"Transpose", &i__1, n, k, &c_b25, &v[(*k + 1) * v_dim1 + 1], dgemm_((char *)"T", (char *)"T", &i__1, n, k, &c_b25, &v[(*k + 1) * v_dim1 + 1], ldv,
ldv, &work[work_offset], ldwork, &c_b14, &c__[*k + 1 + c_dim1], ldc, &work[work_offset], ldwork, &c_b14, &c__[*k + 1 + c_dim1], ldc,
(ftnlen)9, (ftnlen)9); (ftnlen)1, (ftnlen)1);
} }
dtrmm_((char *)"Right", (char *)"Upper", (char *)"No transpose", (char *)"Unit", n, k, &c_b14, &v[v_offset], ldv, dtrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"U", n, k, &c_b14, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *n; i__2 = *n;
@ -209,24 +201,24 @@ int dlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
dcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], &c__1); dcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], &c__1);
} }
dtrmm_((char *)"Right", (char *)"Upper", (char *)"Transpose", (char *)"Unit", m, k, &c_b14, &v[v_offset], ldv, dtrmm_((char *)"R", (char *)"U", (char *)"T", (char *)"U", m, k, &c_b14, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)9, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
dgemm_((char *)"No transpose", (char *)"Transpose", m, k, &i__1, &c_b14, dgemm_((char *)"N", (char *)"T", m, k, &i__1, &c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc,
&c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b14, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b14, &work[work_offset], ldwork,
&work[work_offset], ldwork, (ftnlen)12, (ftnlen)9); (ftnlen)1, (ftnlen)1);
} }
dtrmm_((char *)"Right", (char *)"Upper", trans, (char *)"Non-unit", m, k, &c_b14, &t[t_offset], ldt, dtrmm_((char *)"R", (char *)"U", trans, (char *)"N", m, k, &c_b14, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
dgemm_((char *)"No transpose", (char *)"No transpose", m, &i__1, k, &c_b25, &work[work_offset], dgemm_((char *)"N", (char *)"N", m, &i__1, k, &c_b25, &work[work_offset], ldwork,
ldwork, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b14, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc,
&c__[(*k + 1) * c_dim1 + 1], ldc, (ftnlen)12, (ftnlen)12); (ftnlen)1, (ftnlen)1);
} }
dtrmm_((char *)"Right", (char *)"Upper", (char *)"No transpose", (char *)"Unit", m, k, &c_b14, &v[v_offset], ldv, dtrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"U", m, k, &c_b14, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *m; i__2 = *m;
@ -241,26 +233,22 @@ int dlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
dcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); dcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1);
} }
dtrmm_((char *)"Right", (char *)"Lower", (char *)"Transpose", (char *)"Unit", n, k, &c_b14, dtrmm_((char *)"R", (char *)"L", (char *)"T", (char *)"U", n, k, &c_b14, &v[(*m - *k + 1) * v_dim1 + 1], ldv,
&v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)9, (ftnlen)4);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
dgemm_((char *)"Transpose", (char *)"Transpose", n, k, &i__1, &c_b14, &c__[c_offset], ldc, dgemm_((char *)"T", (char *)"T", n, k, &i__1, &c_b14, &c__[c_offset], ldc, &v[v_offset], ldv,
&v[v_offset], ldv, &c_b14, &work[work_offset], ldwork, (ftnlen)9, &c_b14, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1);
(ftnlen)9);
} }
dtrmm_((char *)"Right", (char *)"Lower", transt, (char *)"Non-unit", n, k, &c_b14, &t[t_offset], ldt, dtrmm_((char *)"R", (char *)"L", transt, (char *)"N", n, k, &c_b14, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
dgemm_((char *)"Transpose", (char *)"Transpose", &i__1, n, k, &c_b25, &v[v_offset], ldv, dgemm_((char *)"T", (char *)"T", &i__1, n, k, &c_b25, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, &c_b14, &c__[c_offset], ldc, (ftnlen)9, ldwork, &c_b14, &c__[c_offset], ldc, (ftnlen)1, (ftnlen)1);
(ftnlen)9);
} }
dtrmm_((char *)"Right", (char *)"Lower", (char *)"No transpose", (char *)"Unit", n, k, &c_b14, dtrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"U", n, k, &c_b14, &v[(*m - *k + 1) * v_dim1 + 1], ldv,
&v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12, (ftnlen)4);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *n; i__2 = *n;
@ -274,26 +262,22 @@ int dlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
dcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], dcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1],
&c__1); &c__1);
} }
dtrmm_((char *)"Right", (char *)"Lower", (char *)"Transpose", (char *)"Unit", m, k, &c_b14, dtrmm_((char *)"R", (char *)"L", (char *)"T", (char *)"U", m, k, &c_b14, &v[(*n - *k + 1) * v_dim1 + 1], ldv,
&v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)9, (ftnlen)4);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
dgemm_((char *)"No transpose", (char *)"Transpose", m, k, &i__1, &c_b14, &c__[c_offset], ldc, dgemm_((char *)"N", (char *)"T", m, k, &i__1, &c_b14, &c__[c_offset], ldc, &v[v_offset], ldv,
&v[v_offset], ldv, &c_b14, &work[work_offset], ldwork, (ftnlen)12, &c_b14, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1);
(ftnlen)9);
} }
dtrmm_((char *)"Right", (char *)"Lower", trans, (char *)"Non-unit", m, k, &c_b14, &t[t_offset], ldt, dtrmm_((char *)"R", (char *)"L", trans, (char *)"N", m, k, &c_b14, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
dgemm_((char *)"No transpose", (char *)"No transpose", m, &i__1, k, &c_b25, &work[work_offset], dgemm_((char *)"N", (char *)"N", m, &i__1, k, &c_b25, &work[work_offset], ldwork, &v[v_offset],
ldwork, &v[v_offset], ldv, &c_b14, &c__[c_offset], ldc, (ftnlen)12, ldv, &c_b14, &c__[c_offset], ldc, (ftnlen)1, (ftnlen)1);
(ftnlen)12);
} }
dtrmm_((char *)"Right", (char *)"Lower", (char *)"No transpose", (char *)"Unit", m, k, &c_b14, dtrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"U", m, k, &c_b14, &v[(*n - *k + 1) * v_dim1 + 1], ldv,
&v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12, (ftnlen)4);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *m; i__2 = *m;

43
lib/linalg/dlasd3.cpp
View File

@ -4,8 +4,8 @@ extern "C" {
#include "lmp_f2c.h" #include "lmp_f2c.h"
static integer c__1 = 1; static integer c__1 = 1;
static integer c__0 = 0; static integer c__0 = 0;
static doublereal c_b13 = 1.; static doublereal c_b12 = 1.;
static doublereal c_b26 = 0.; static doublereal c_b25 = 0.;
int dlasd3_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__, doublereal *q, int dlasd3_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__, doublereal *q,
integer *ldq, doublereal *dsigma, doublereal *u, integer *ldu, doublereal *u2, integer *ldq, doublereal *dsigma, doublereal *u, integer *ldu, doublereal *u2,
integer *ldu2, doublereal *vt, integer *ldvt, doublereal *vt2, integer *ldvt2, integer *ldu2, doublereal *vt, integer *ldvt, doublereal *vt2, integer *ldvt2,
@ -26,7 +26,6 @@ int dlasd3_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__
integer ctemp; integer ctemp;
extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *); extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *);
integer ktemp; integer ktemp;
extern doublereal dlamc3_(doublereal *, doublereal *);
extern int dlasd4_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, extern int dlasd4_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, integer *), doublereal *, doublereal *, integer *),
dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *,
@ -97,13 +96,9 @@ int dlasd3_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__
} }
return 0; return 0;
} }
i__1 = *k;
for (i__ = 1; i__ <= i__1; ++i__) {
dsigma[i__] = dlamc3_(&dsigma[i__], &dsigma[i__]) - dsigma[i__];
}
dcopy_(k, &z__[1], &c__1, &q[q_offset], &c__1); dcopy_(k, &z__[1], &c__1, &q[q_offset], &c__1);
rho = dnrm2_(k, &z__[1], &c__1); rho = dnrm2_(k, &z__[1], &c__1);
dlascl_((char *)"G", &c__0, &c__0, &rho, &c_b13, k, &c__1, &z__[1], k, info, (ftnlen)1); dlascl_((char *)"G", &c__0, &c__0, &rho, &c_b12, k, &c__1, &z__[1], k, info, (ftnlen)1);
rho *= rho; rho *= rho;
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
@ -147,30 +142,30 @@ int dlasd3_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__
} }
} }
if (*k == 2) { if (*k == 2) {
dgemm_((char *)"N", (char *)"N", &n, k, k, &c_b13, &u2[u2_offset], ldu2, &q[q_offset], ldq, &c_b26, dgemm_((char *)"N", (char *)"N", &n, k, k, &c_b12, &u2[u2_offset], ldu2, &q[q_offset], ldq, &c_b25,
&u[u_offset], ldu, (ftnlen)1, (ftnlen)1); &u[u_offset], ldu, (ftnlen)1, (ftnlen)1);
goto L100; goto L100;
} }
if (ctot[1] > 0) { if (ctot[1] > 0) {
dgemm_((char *)"N", (char *)"N", nl, k, &ctot[1], &c_b13, &u2[(u2_dim1 << 1) + 1], ldu2, &q[q_dim1 + 2], dgemm_((char *)"N", (char *)"N", nl, k, &ctot[1], &c_b12, &u2[(u2_dim1 << 1) + 1], ldu2, &q[q_dim1 + 2],
ldq, &c_b26, &u[u_dim1 + 1], ldu, (ftnlen)1, (ftnlen)1); ldq, &c_b25, &u[u_dim1 + 1], ldu, (ftnlen)1, (ftnlen)1);
if (ctot[3] > 0) { if (ctot[3] > 0) {
ktemp = ctot[1] + 2 + ctot[2]; ktemp = ctot[1] + 2 + ctot[2];
dgemm_((char *)"N", (char *)"N", nl, k, &ctot[3], &c_b13, &u2[ktemp * u2_dim1 + 1], ldu2, dgemm_((char *)"N", (char *)"N", nl, k, &ctot[3], &c_b12, &u2[ktemp * u2_dim1 + 1], ldu2,
&q[ktemp + q_dim1], ldq, &c_b13, &u[u_dim1 + 1], ldu, (ftnlen)1, (ftnlen)1); &q[ktemp + q_dim1], ldq, &c_b12, &u[u_dim1 + 1], ldu, (ftnlen)1, (ftnlen)1);
} }
} else if (ctot[3] > 0) { } else if (ctot[3] > 0) {
ktemp = ctot[1] + 2 + ctot[2]; ktemp = ctot[1] + 2 + ctot[2];
dgemm_((char *)"N", (char *)"N", nl, k, &ctot[3], &c_b13, &u2[ktemp * u2_dim1 + 1], ldu2, dgemm_((char *)"N", (char *)"N", nl, k, &ctot[3], &c_b12, &u2[ktemp * u2_dim1 + 1], ldu2,
&q[ktemp + q_dim1], ldq, &c_b26, &u[u_dim1 + 1], ldu, (ftnlen)1, (ftnlen)1); &q[ktemp + q_dim1], ldq, &c_b25, &u[u_dim1 + 1], ldu, (ftnlen)1, (ftnlen)1);
} else { } else {
dlacpy_((char *)"F", nl, k, &u2[u2_offset], ldu2, &u[u_offset], ldu, (ftnlen)1); dlacpy_((char *)"F", nl, k, &u2[u2_offset], ldu2, &u[u_offset], ldu, (ftnlen)1);
} }
dcopy_(k, &q[q_dim1 + 1], ldq, &u[nlp1 + u_dim1], ldu); dcopy_(k, &q[q_dim1 + 1], ldq, &u[nlp1 + u_dim1], ldu);
ktemp = ctot[1] + 2; ktemp = ctot[1] + 2;
ctemp = ctot[2] + ctot[3]; ctemp = ctot[2] + ctot[3];
dgemm_((char *)"N", (char *)"N", nr, k, &ctemp, &c_b13, &u2[nlp2 + ktemp * u2_dim1], ldu2, &q[ktemp + q_dim1], dgemm_((char *)"N", (char *)"N", nr, k, &ctemp, &c_b12, &u2[nlp2 + ktemp * u2_dim1], ldu2, &q[ktemp + q_dim1],
ldq, &c_b26, &u[nlp2 + u_dim1], ldu, (ftnlen)1, (ftnlen)1); ldq, &c_b25, &u[nlp2 + u_dim1], ldu, (ftnlen)1, (ftnlen)1);
L100: L100:
i__1 = *k; i__1 = *k;
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
@ -183,17 +178,17 @@ L100:
} }
} }
if (*k == 2) { if (*k == 2) {
dgemm_((char *)"N", (char *)"N", k, &m, k, &c_b13, &q[q_offset], ldq, &vt2[vt2_offset], ldvt2, &c_b26, dgemm_((char *)"N", (char *)"N", k, &m, k, &c_b12, &q[q_offset], ldq, &vt2[vt2_offset], ldvt2, &c_b25,
&vt[vt_offset], ldvt, (ftnlen)1, (ftnlen)1); &vt[vt_offset], ldvt, (ftnlen)1, (ftnlen)1);
return 0; return 0;
} }
ktemp = ctot[1] + 1; ktemp = ctot[1] + 1;
dgemm_((char *)"N", (char *)"N", k, &nlp1, &ktemp, &c_b13, &q[q_dim1 + 1], ldq, &vt2[vt2_dim1 + 1], ldvt2, dgemm_((char *)"N", (char *)"N", k, &nlp1, &ktemp, &c_b12, &q[q_dim1 + 1], ldq, &vt2[vt2_dim1 + 1], ldvt2,
&c_b26, &vt[vt_dim1 + 1], ldvt, (ftnlen)1, (ftnlen)1); &c_b25, &vt[vt_dim1 + 1], ldvt, (ftnlen)1, (ftnlen)1);
ktemp = ctot[1] + 2 + ctot[2]; ktemp = ctot[1] + 2 + ctot[2];
if (ktemp <= *ldvt2) { if (ktemp <= *ldvt2) {
dgemm_((char *)"N", (char *)"N", k, &nlp1, &ctot[3], &c_b13, &q[ktemp * q_dim1 + 1], ldq, dgemm_((char *)"N", (char *)"N", k, &nlp1, &ctot[3], &c_b12, &q[ktemp * q_dim1 + 1], ldq,
&vt2[ktemp + vt2_dim1], ldvt2, &c_b13, &vt[vt_dim1 + 1], ldvt, (ftnlen)1, (ftnlen)1); &vt2[ktemp + vt2_dim1], ldvt2, &c_b12, &vt[vt_dim1 + 1], ldvt, (ftnlen)1, (ftnlen)1);
} }
ktemp = ctot[1] + 1; ktemp = ctot[1] + 1;
nrp1 = *nr + *sqre; nrp1 = *nr + *sqre;
@ -208,8 +203,8 @@ L100:
} }
} }
ctemp = ctot[2] + 1 + ctot[3]; ctemp = ctot[2] + 1 + ctot[3];
dgemm_((char *)"N", (char *)"N", k, &nrp1, &ctemp, &c_b13, &q[ktemp * q_dim1 + 1], ldq, dgemm_((char *)"N", (char *)"N", k, &nrp1, &ctemp, &c_b12, &q[ktemp * q_dim1 + 1], ldq,
&vt2[ktemp + nlp2 * vt2_dim1], ldvt2, &c_b26, &vt[nlp2 * vt_dim1 + 1], ldvt, (ftnlen)1, &vt2[ktemp + nlp2 * vt2_dim1], ldvt2, &c_b25, &vt[nlp2 * vt_dim1 + 1], ldvt, (ftnlen)1,
(ftnlen)1); (ftnlen)1);
return 0; return 0;
} }

74
lib/linalg/dlasyf.cpp
View File

@ -8,17 +8,14 @@ static doublereal c_b9 = 1.;
int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, integer *lda, int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, integer *lda,
integer *ipiv, doublereal *w, integer *ldw, integer *info, ftnlen uplo_len) integer *ipiv, doublereal *w, integer *ldw, integer *info, ftnlen uplo_len)
{ {
integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4, i__5; integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
doublereal d__1, d__2, d__3; doublereal d__1, d__2, d__3;
double sqrt(doublereal); double sqrt(doublereal);
integer j, k; integer j, k;
doublereal t, r1, d11, d21, d22; doublereal t, r1, d11, d21, d22;
integer jb, jj, kk, jp, kp, kw, kkw, imax, jmax; integer jj, kk, jp, kp, kw, kkw, imax, jmax;
doublereal alpha; doublereal alpha;
extern int dscal_(integer *, doublereal *, doublereal *, integer *), extern int dscal_(integer *, doublereal *, doublereal *, integer *);
dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen,
ftnlen);
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, extern int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *,
doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen), doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen),
@ -28,6 +25,9 @@ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, int
doublereal absakk; doublereal absakk;
extern integer idamax_(integer *, doublereal *, integer *); extern integer idamax_(integer *, doublereal *, integer *);
doublereal colmax, rowmax; doublereal colmax, rowmax;
extern int dgemmtr_(char *, char *, char *, integer *, integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *, doublereal *, doublereal *, integer *,
ftnlen, ftnlen, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -47,8 +47,8 @@ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, int
dcopy_(&k, &a[k * a_dim1 + 1], &c__1, &w[kw * w_dim1 + 1], &c__1); dcopy_(&k, &a[k * a_dim1 + 1], &c__1, &w[kw * w_dim1 + 1], &c__1);
if (k < *n) { if (k < *n) {
i__1 = *n - k; i__1 = *n - k;
dgemv_((char *)"No transpose", &k, &i__1, &c_b8, &a[(k + 1) * a_dim1 + 1], lda, dgemv_((char *)"N", &k, &i__1, &c_b8, &a[(k + 1) * a_dim1 + 1], lda, &w[k + (kw + 1) * w_dim1],
&w[k + (kw + 1) * w_dim1], ldw, &c_b9, &w[kw * w_dim1 + 1], &c__1, (ftnlen)12); ldw, &c_b9, &w[kw * w_dim1 + 1], &c__1, (ftnlen)1);
} }
kstep = 1; kstep = 1;
absakk = (d__1 = w[k + kw * w_dim1], abs(d__1)); absakk = (d__1 = w[k + kw * w_dim1], abs(d__1));
@ -74,9 +74,9 @@ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, int
&c__1); &c__1);
if (k < *n) { if (k < *n) {
i__1 = *n - k; i__1 = *n - k;
dgemv_((char *)"No transpose", &k, &i__1, &c_b8, &a[(k + 1) * a_dim1 + 1], lda, dgemv_((char *)"N", &k, &i__1, &c_b8, &a[(k + 1) * a_dim1 + 1], lda,
&w[imax + (kw + 1) * w_dim1], ldw, &c_b9, &w[(kw - 1) * w_dim1 + 1], &w[imax + (kw + 1) * w_dim1], ldw, &c_b9, &w[(kw - 1) * w_dim1 + 1],
&c__1, (ftnlen)12); &c__1, (ftnlen)1);
} }
i__1 = k - imax; i__1 = k - imax;
jmax = imax + idamax_(&i__1, &w[imax + 1 + (kw - 1) * w_dim1], &c__1); jmax = imax + idamax_(&i__1, &w[imax + 1 + (kw - 1) * w_dim1], &c__1);
@ -148,24 +148,10 @@ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, int
k -= kstep; k -= kstep;
goto L10; goto L10;
L30: L30:
i__1 = -(*nb); i__1 = *n - k;
for (j = (k - 1) / *nb * *nb + 1; i__1 < 0 ? j >= 1 : j <= 1; j += i__1) { dgemmtr_((char *)"U", (char *)"N", (char *)"T", &k, &i__1, &c_b8, &a[(k + 1) * a_dim1 + 1], lda,
i__2 = *nb, i__3 = k - j + 1; &w[(kw + 1) * w_dim1 + 1], ldw, &c_b9, &a[a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1,
jb = min(i__2, i__3); (ftnlen)1);
i__2 = j + jb - 1;
for (jj = j; jj <= i__2; ++jj) {
i__3 = jj - j + 1;
i__4 = *n - k;
dgemv_((char *)"No transpose", &i__3, &i__4, &c_b8, &a[j + (k + 1) * a_dim1], lda,
&w[jj + (kw + 1) * w_dim1], ldw, &c_b9, &a[j + jj * a_dim1], &c__1,
(ftnlen)12);
}
i__2 = j - 1;
i__3 = *n - k;
dgemm_((char *)"No transpose", (char *)"Transpose", &i__2, &jb, &i__3, &c_b8, &a[(k + 1) * a_dim1 + 1],
lda, &w[j + (kw + 1) * w_dim1], ldw, &c_b9, &a[j * a_dim1 + 1], lda, (ftnlen)12,
(ftnlen)9);
}
j = k + 1; j = k + 1;
L60: L60:
jj = j; jj = j;
@ -193,8 +179,8 @@ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, int
dcopy_(&i__1, &a[k + k * a_dim1], &c__1, &w[k + k * w_dim1], &c__1); dcopy_(&i__1, &a[k + k * a_dim1], &c__1, &w[k + k * w_dim1], &c__1);
i__1 = *n - k + 1; i__1 = *n - k + 1;
i__2 = k - 1; i__2 = k - 1;
dgemv_((char *)"No transpose", &i__1, &i__2, &c_b8, &a[k + a_dim1], lda, &w[k + w_dim1], ldw, &c_b9, dgemv_((char *)"N", &i__1, &i__2, &c_b8, &a[k + a_dim1], lda, &w[k + w_dim1], ldw, &c_b9,
&w[k + k * w_dim1], &c__1, (ftnlen)12); &w[k + k * w_dim1], &c__1, (ftnlen)1);
kstep = 1; kstep = 1;
absakk = (d__1 = w[k + k * w_dim1], abs(d__1)); absakk = (d__1 = w[k + k * w_dim1], abs(d__1));
if (k < *n) { if (k < *n) {
@ -219,8 +205,8 @@ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, int
dcopy_(&i__1, &a[imax + imax * a_dim1], &c__1, &w[imax + (k + 1) * w_dim1], &c__1); dcopy_(&i__1, &a[imax + imax * a_dim1], &c__1, &w[imax + (k + 1) * w_dim1], &c__1);
i__1 = *n - k + 1; i__1 = *n - k + 1;
i__2 = k - 1; i__2 = k - 1;
dgemv_((char *)"No transpose", &i__1, &i__2, &c_b8, &a[k + a_dim1], lda, &w[imax + w_dim1], dgemv_((char *)"N", &i__1, &i__2, &c_b8, &a[k + a_dim1], lda, &w[imax + w_dim1], ldw, &c_b9,
ldw, &c_b9, &w[k + (k + 1) * w_dim1], &c__1, (ftnlen)12); &w[k + (k + 1) * w_dim1], &c__1, (ftnlen)1);
i__1 = imax - k; i__1 = imax - k;
jmax = k - 1 + idamax_(&i__1, &w[k + (k + 1) * w_dim1], &c__1); jmax = k - 1 + idamax_(&i__1, &w[k + (k + 1) * w_dim1], &c__1);
rowmax = (d__1 = w[jmax + (k + 1) * w_dim1], abs(d__1)); rowmax = (d__1 = w[jmax + (k + 1) * w_dim1], abs(d__1));
@ -293,26 +279,10 @@ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, int
k += kstep; k += kstep;
goto L70; goto L70;
L90: L90:
i__1 = *n; i__1 = *n - k + 1;
i__2 = *nb; i__2 = k - 1;
for (j = k; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) { dgemmtr_((char *)"L", (char *)"N", (char *)"T", &i__1, &i__2, &c_b8, &a[k + a_dim1], lda, &w[k + w_dim1], ldw,
i__3 = *nb, i__4 = *n - j + 1; &c_b9, &a[k + k * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1);
jb = min(i__3, i__4);
i__3 = j + jb - 1;
for (jj = j; jj <= i__3; ++jj) {
i__4 = j + jb - jj;
i__5 = k - 1;
dgemv_((char *)"No transpose", &i__4, &i__5, &c_b8, &a[jj + a_dim1], lda, &w[jj + w_dim1],
ldw, &c_b9, &a[jj + jj * a_dim1], &c__1, (ftnlen)12);
}
if (j + jb <= *n) {
i__3 = *n - j - jb + 1;
i__4 = k - 1;
dgemm_((char *)"No transpose", (char *)"Transpose", &i__3, &jb, &i__4, &c_b8, &a[j + jb + a_dim1],
lda, &w[j + w_dim1], ldw, &c_b9, &a[j + jb + j * a_dim1], lda, (ftnlen)12,
(ftnlen)9);
}
}
j = k - 1; j = k - 1;
L120: L120:
jj = j; jj = j;

58
lib/linalg/dlatrd.cpp
View File

@ -38,13 +38,13 @@ int dlatrd_(char *uplo, integer *n, integer *nb, doublereal *a, integer *lda, do
iw = i__ - *n + *nb; iw = i__ - *n + *nb;
if (i__ < *n) { if (i__ < *n) {
i__2 = *n - i__; i__2 = *n - i__;
dgemv_((char *)"No transpose", &i__, &i__2, &c_b5, &a[(i__ + 1) * a_dim1 + 1], lda, dgemv_((char *)"N", &i__, &i__2, &c_b5, &a[(i__ + 1) * a_dim1 + 1], lda,
&w[i__ + (iw + 1) * w_dim1], ldw, &c_b6, &a[i__ * a_dim1 + 1], &c__1, &w[i__ + (iw + 1) * w_dim1], ldw, &c_b6, &a[i__ * a_dim1 + 1], &c__1,
(ftnlen)12); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
dgemv_((char *)"No transpose", &i__, &i__2, &c_b5, &w[(iw + 1) * w_dim1 + 1], ldw, dgemv_((char *)"N", &i__, &i__2, &c_b5, &w[(iw + 1) * w_dim1 + 1], ldw,
&a[i__ + (i__ + 1) * a_dim1], lda, &c_b6, &a[i__ * a_dim1 + 1], &c__1, &a[i__ + (i__ + 1) * a_dim1], lda, &c_b6, &a[i__ * a_dim1 + 1], &c__1,
(ftnlen)12); (ftnlen)1);
} }
if (i__ > 1) { if (i__ > 1) {
i__2 = i__ - 1; i__2 = i__ - 1;
@ -53,29 +53,29 @@ int dlatrd_(char *uplo, integer *n, integer *nb, doublereal *a, integer *lda, do
e[i__ - 1] = a[i__ - 1 + i__ * a_dim1]; e[i__ - 1] = a[i__ - 1 + i__ * a_dim1];
a[i__ - 1 + i__ * a_dim1] = 1.; a[i__ - 1 + i__ * a_dim1] = 1.;
i__2 = i__ - 1; i__2 = i__ - 1;
dsymv_((char *)"Upper", &i__2, &c_b6, &a[a_offset], lda, &a[i__ * a_dim1 + 1], &c__1, dsymv_((char *)"U", &i__2, &c_b6, &a[a_offset], lda, &a[i__ * a_dim1 + 1], &c__1, &c_b16,
&c_b16, &w[iw * w_dim1 + 1], &c__1, (ftnlen)5); &w[iw * w_dim1 + 1], &c__1, (ftnlen)1);
if (i__ < *n) { if (i__ < *n) {
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b6, &w[(iw + 1) * w_dim1 + 1], ldw, dgemv_((char *)"T", &i__2, &i__3, &c_b6, &w[(iw + 1) * w_dim1 + 1], ldw,
&a[i__ * a_dim1 + 1], &c__1, &c_b16, &w[i__ + 1 + iw * w_dim1], &c__1, &a[i__ * a_dim1 + 1], &c__1, &c_b16, &w[i__ + 1 + iw * w_dim1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b5, &a[(i__ + 1) * a_dim1 + 1], lda, dgemv_((char *)"N", &i__2, &i__3, &c_b5, &a[(i__ + 1) * a_dim1 + 1], lda,
&w[i__ + 1 + iw * w_dim1], &c__1, &c_b6, &w[iw * w_dim1 + 1], &c__1, &w[i__ + 1 + iw * w_dim1], &c__1, &c_b6, &w[iw * w_dim1 + 1], &c__1,
(ftnlen)12); (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b6, &a[(i__ + 1) * a_dim1 + 1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b6, &a[(i__ + 1) * a_dim1 + 1], lda,
&a[i__ * a_dim1 + 1], &c__1, &c_b16, &w[i__ + 1 + iw * w_dim1], &c__1, &a[i__ * a_dim1 + 1], &c__1, &c_b16, &w[i__ + 1 + iw * w_dim1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b5, &w[(iw + 1) * w_dim1 + 1], ldw, dgemv_((char *)"N", &i__2, &i__3, &c_b5, &w[(iw + 1) * w_dim1 + 1], ldw,
&w[i__ + 1 + iw * w_dim1], &c__1, &c_b6, &w[iw * w_dim1 + 1], &c__1, &w[i__ + 1 + iw * w_dim1], &c__1, &c_b6, &w[iw * w_dim1 + 1], &c__1,
(ftnlen)12); (ftnlen)1);
} }
i__2 = i__ - 1; i__2 = i__ - 1;
dscal_(&i__2, &tau[i__ - 1], &w[iw * w_dim1 + 1], &c__1); dscal_(&i__2, &tau[i__ - 1], &w[iw * w_dim1 + 1], &c__1);
@ -91,12 +91,12 @@ int dlatrd_(char *uplo, integer *n, integer *nb, doublereal *a, integer *lda, do
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = *n - i__ + 1; i__2 = *n - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b5, &a[i__ + a_dim1], lda, &w[i__ + w_dim1], dgemv_((char *)"N", &i__2, &i__3, &c_b5, &a[i__ + a_dim1], lda, &w[i__ + w_dim1], ldw, &c_b6,
ldw, &c_b6, &a[i__ + i__ * a_dim1], &c__1, (ftnlen)12); &a[i__ + i__ * a_dim1], &c__1, (ftnlen)1);
i__2 = *n - i__ + 1; i__2 = *n - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b5, &w[i__ + w_dim1], ldw, &a[i__ + a_dim1], dgemv_((char *)"N", &i__2, &i__3, &c_b5, &w[i__ + w_dim1], ldw, &a[i__ + a_dim1], lda, &c_b6,
lda, &c_b6, &a[i__ + i__ * a_dim1], &c__1, (ftnlen)12); &a[i__ + i__ * a_dim1], &c__1, (ftnlen)1);
if (i__ < *n) { if (i__ < *n) {
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ + 2; i__3 = i__ + 2;
@ -105,29 +105,27 @@ int dlatrd_(char *uplo, integer *n, integer *nb, doublereal *a, integer *lda, do
e[i__] = a[i__ + 1 + i__ * a_dim1]; e[i__] = a[i__ + 1 + i__ * a_dim1];
a[i__ + 1 + i__ * a_dim1] = 1.; a[i__ + 1 + i__ * a_dim1] = 1.;
i__2 = *n - i__; i__2 = *n - i__;
dsymv_((char *)"Lower", &i__2, &c_b6, &a[i__ + 1 + (i__ + 1) * a_dim1], lda, dsymv_((char *)"L", &i__2, &c_b6, &a[i__ + 1 + (i__ + 1) * a_dim1], lda,
&a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &w[i__ + 1 + i__ * w_dim1], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &w[i__ + 1 + i__ * w_dim1], &c__1,
(ftnlen)5); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b6, &w[i__ + 1 + w_dim1], ldw, dgemv_((char *)"T", &i__2, &i__3, &c_b6, &w[i__ + 1 + w_dim1], ldw,
&a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &w[i__ * w_dim1 + 1], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &w[i__ * w_dim1 + 1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b5, &a[i__ + 1 + a_dim1], lda, dgemv_((char *)"N", &i__2, &i__3, &c_b5, &a[i__ + 1 + a_dim1], lda, &w[i__ * w_dim1 + 1],
&w[i__ * w_dim1 + 1], &c__1, &c_b6, &w[i__ + 1 + i__ * w_dim1], &c__1, &c__1, &c_b6, &w[i__ + 1 + i__ * w_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b6, &a[i__ + 1 + a_dim1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b6, &a[i__ + 1 + a_dim1], lda,
&a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &w[i__ * w_dim1 + 1], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b16, &w[i__ * w_dim1 + 1], &c__1,
(ftnlen)9); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b5, &w[i__ + 1 + w_dim1], ldw, dgemv_((char *)"N", &i__2, &i__3, &c_b5, &w[i__ + 1 + w_dim1], ldw, &w[i__ * w_dim1 + 1],
&w[i__ * w_dim1 + 1], &c__1, &c_b6, &w[i__ + 1 + i__ * w_dim1], &c__1, &c__1, &c_b6, &w[i__ + 1 + i__ * w_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = *n - i__; i__2 = *n - i__;
dscal_(&i__2, &tau[i__], &w[i__ + 1 + i__ * w_dim1], &c__1); dscal_(&i__2, &tau[i__], &w[i__ + 1 + i__ * w_dim1], &c__1);
i__2 = *n - i__; i__2 = *n - i__;

8
lib/linalg/dlauu2.cpp
View File

@ -46,9 +46,9 @@ int dlauu2_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info,
ddot_(&i__2, &a[i__ + i__ * a_dim1], lda, &a[i__ + i__ * a_dim1], lda); ddot_(&i__2, &a[i__ + i__ * a_dim1], lda, &a[i__ + i__ * a_dim1], lda);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b7, &a[(i__ + 1) * a_dim1 + 1], lda, dgemv_((char *)"N", &i__2, &i__3, &c_b7, &a[(i__ + 1) * a_dim1 + 1], lda,
&a[i__ + (i__ + 1) * a_dim1], lda, &aii, &a[i__ * a_dim1 + 1], &c__1, &a[i__ + (i__ + 1) * a_dim1], lda, &aii, &a[i__ * a_dim1 + 1], &c__1,
(ftnlen)12); (ftnlen)1);
} else { } else {
dscal_(&i__, &aii, &a[i__ * a_dim1 + 1], &c__1); dscal_(&i__, &aii, &a[i__ * a_dim1 + 1], &c__1);
} }
@ -63,8 +63,8 @@ int dlauu2_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info,
ddot_(&i__2, &a[i__ + i__ * a_dim1], &c__1, &a[i__ + i__ * a_dim1], &c__1); ddot_(&i__2, &a[i__ + i__ * a_dim1], &c__1, &a[i__ + i__ * a_dim1], &c__1);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b7, &a[i__ + 1 + a_dim1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b7, &a[i__ + 1 + a_dim1], lda,
&a[i__ + 1 + i__ * a_dim1], &c__1, &aii, &a[i__ + a_dim1], lda, (ftnlen)9); &a[i__ + 1 + i__ * a_dim1], &c__1, &aii, &a[i__ + a_dim1], lda, (ftnlen)1);
} else { } else {
dscal_(&i__, &aii, &a[i__ + a_dim1], lda); dscal_(&i__, &aii, &a[i__ + a_dim1], lda);
} }

35
lib/linalg/dlauum.cpp
View File

@ -54,20 +54,18 @@ int dlauum_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info,
i__3 = nb, i__4 = *n - i__ + 1; i__3 = nb, i__4 = *n - i__ + 1;
ib = min(i__3, i__4); ib = min(i__3, i__4);
i__3 = i__ - 1; i__3 = i__ - 1;
dtrmm_((char *)"Right", (char *)"Upper", (char *)"Transpose", (char *)"Non-unit", &i__3, &ib, &c_b15, dtrmm_((char *)"R", (char *)"U", (char *)"T", (char *)"N", &i__3, &ib, &c_b15, &a[i__ + i__ * a_dim1], lda,
&a[i__ + i__ * a_dim1], lda, &a[i__ * a_dim1 + 1], lda, (ftnlen)5, (ftnlen)5, &a[i__ * a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)9, (ftnlen)8); dlauu2_((char *)"U", &ib, &a[i__ + i__ * a_dim1], lda, info, (ftnlen)1);
dlauu2_((char *)"Upper", &ib, &a[i__ + i__ * a_dim1], lda, info, (ftnlen)5);
if (i__ + ib <= *n) { if (i__ + ib <= *n) {
i__3 = i__ - 1; i__3 = i__ - 1;
i__4 = *n - i__ - ib + 1; i__4 = *n - i__ - ib + 1;
dgemm_((char *)"No transpose", (char *)"Transpose", &i__3, &ib, &i__4, &c_b15, dgemm_((char *)"N", (char *)"T", &i__3, &ib, &i__4, &c_b15, &a[(i__ + ib) * a_dim1 + 1], lda,
&a[(i__ + ib) * a_dim1 + 1], lda, &a[i__ + (i__ + ib) * a_dim1], lda, &a[i__ + (i__ + ib) * a_dim1], lda, &c_b15, &a[i__ * a_dim1 + 1], lda,
&c_b15, &a[i__ * a_dim1 + 1], lda, (ftnlen)12, (ftnlen)9); (ftnlen)1, (ftnlen)1);
i__3 = *n - i__ - ib + 1; i__3 = *n - i__ - ib + 1;
dsyrk_((char *)"Upper", (char *)"No transpose", &ib, &i__3, &c_b15, dsyrk_((char *)"U", (char *)"N", &ib, &i__3, &c_b15, &a[i__ + (i__ + ib) * a_dim1], lda, &c_b15,
&a[i__ + (i__ + ib) * a_dim1], lda, &c_b15, &a[i__ + i__ * a_dim1], lda, &a[i__ + i__ * a_dim1], lda, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12);
} }
} }
} else { } else {
@ -77,19 +75,18 @@ int dlauum_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info,
i__3 = nb, i__4 = *n - i__ + 1; i__3 = nb, i__4 = *n - i__ + 1;
ib = min(i__3, i__4); ib = min(i__3, i__4);
i__3 = i__ - 1; i__3 = i__ - 1;
dtrmm_((char *)"Left", (char *)"Lower", (char *)"Transpose", (char *)"Non-unit", &ib, &i__3, &c_b15, dtrmm_((char *)"L", (char *)"L", (char *)"T", (char *)"N", &ib, &i__3, &c_b15, &a[i__ + i__ * a_dim1], lda,
&a[i__ + i__ * a_dim1], lda, &a[i__ + a_dim1], lda, (ftnlen)4, (ftnlen)5, &a[i__ + a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)9, (ftnlen)8); dlauu2_((char *)"L", &ib, &a[i__ + i__ * a_dim1], lda, info, (ftnlen)1);
dlauu2_((char *)"Lower", &ib, &a[i__ + i__ * a_dim1], lda, info, (ftnlen)5);
if (i__ + ib <= *n) { if (i__ + ib <= *n) {
i__3 = i__ - 1; i__3 = i__ - 1;
i__4 = *n - i__ - ib + 1; i__4 = *n - i__ - ib + 1;
dgemm_((char *)"Transpose", (char *)"No transpose", &ib, &i__3, &i__4, &c_b15, dgemm_((char *)"T", (char *)"N", &ib, &i__3, &i__4, &c_b15, &a[i__ + ib + i__ * a_dim1], lda,
&a[i__ + ib + i__ * a_dim1], lda, &a[i__ + ib + a_dim1], lda, &c_b15, &a[i__ + ib + a_dim1], lda, &c_b15, &a[i__ + a_dim1], lda, (ftnlen)1,
&a[i__ + a_dim1], lda, (ftnlen)9, (ftnlen)12); (ftnlen)1);
i__3 = *n - i__ - ib + 1; i__3 = *n - i__ - ib + 1;
dsyrk_((char *)"Lower", (char *)"Transpose", &ib, &i__3, &c_b15, &a[i__ + ib + i__ * a_dim1], dsyrk_((char *)"L", (char *)"T", &ib, &i__3, &c_b15, &a[i__ + ib + i__ * a_dim1], lda, &c_b15,
lda, &c_b15, &a[i__ + i__ * a_dim1], lda, (ftnlen)5, (ftnlen)9); &a[i__ + i__ * a_dim1], lda, (ftnlen)1, (ftnlen)1);
} }
} }
} }

11
lib/linalg/dorg2l.cpp
View File

@ -10,9 +10,9 @@ int dorg2l_(integer *m, integer *n, integer *k, doublereal *a, integer *lda, dou
doublereal d__1; doublereal d__1;
integer i__, j, l, ii; integer i__, j, l, ii;
extern int dscal_(integer *, doublereal *, doublereal *, integer *), extern int dscal_(integer *, doublereal *, doublereal *, integer *),
dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, xerbla_(char *, integer *, ftnlen),
integer *, doublereal *, ftnlen), dlarf1l_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *,
xerbla_(char *, integer *, ftnlen); integer *, doublereal *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -47,11 +47,10 @@ int dorg2l_(integer *m, integer *n, integer *k, doublereal *a, integer *lda, dou
i__1 = *k; i__1 = *k;
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
ii = *n - *k + i__; ii = *n - *k + i__;
a[*m - *n + ii + ii * a_dim1] = 1.;
i__2 = *m - *n + ii; i__2 = *m - *n + ii;
i__3 = ii - 1; i__3 = ii - 1;
dlarf_((char *)"Left", &i__2, &i__3, &a[ii * a_dim1 + 1], &c__1, &tau[i__], &a[a_offset], lda, dlarf1l_((char *)"L", &i__2, &i__3, &a[ii * a_dim1 + 1], &c__1, &tau[i__], &a[a_offset], lda,
&work[1], (ftnlen)4); &work[1], (ftnlen)1);
i__2 = *m - *n + ii - 1; i__2 = *m - *n + ii - 1;
d__1 = -tau[i__]; d__1 = -tau[i__];
dscal_(&i__2, &d__1, &a[ii * a_dim1 + 1], &c__1); dscal_(&i__2, &d__1, &a[ii * a_dim1 + 1], &c__1);

11
lib/linalg/dorg2r.cpp
View File

@ -10,9 +10,9 @@ int dorg2r_(integer *m, integer *n, integer *k, doublereal *a, integer *lda, dou
doublereal d__1; doublereal d__1;
integer i__, j, l; integer i__, j, l;
extern int dscal_(integer *, doublereal *, doublereal *, integer *), extern int dscal_(integer *, doublereal *, doublereal *, integer *),
dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, xerbla_(char *, integer *, ftnlen),
integer *, doublereal *, ftnlen), dlarf1f_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *,
xerbla_(char *, integer *, ftnlen); integer *, doublereal *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -46,11 +46,10 @@ int dorg2r_(integer *m, integer *n, integer *k, doublereal *a, integer *lda, dou
} }
for (i__ = *k; i__ >= 1; --i__) { for (i__ = *k; i__ >= 1; --i__) {
if (i__ < *n) { if (i__ < *n) {
a[i__ + i__ * a_dim1] = 1.;
i__1 = *m - i__ + 1; i__1 = *m - i__ + 1;
i__2 = *n - i__; i__2 = *n - i__;
dlarf_((char *)"Left", &i__1, &i__2, &a[i__ + i__ * a_dim1], &c__1, &tau[i__], dlarf1f_((char *)"L", &i__1, &i__2, &a[i__ + i__ * a_dim1], &c__1, &tau[i__],
&a[i__ + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)4); &a[i__ + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)1);
} }
if (i__ < *m) { if (i__ < *m) {
i__1 = *m - i__; i__1 = *m - i__;

11
lib/linalg/dorgl2.cpp
View File

@ -9,9 +9,9 @@ int dorgl2_(integer *m, integer *n, integer *k, doublereal *a, integer *lda, dou
doublereal d__1; doublereal d__1;
integer i__, j, l; integer i__, j, l;
extern int dscal_(integer *, doublereal *, doublereal *, integer *), extern int dscal_(integer *, doublereal *, doublereal *, integer *),
dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, xerbla_(char *, integer *, ftnlen),
integer *, doublereal *, ftnlen), dlarf1f_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *,
xerbla_(char *, integer *, ftnlen); integer *, doublereal *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -50,11 +50,10 @@ int dorgl2_(integer *m, integer *n, integer *k, doublereal *a, integer *lda, dou
for (i__ = *k; i__ >= 1; --i__) { for (i__ = *k; i__ >= 1; --i__) {
if (i__ < *n) { if (i__ < *n) {
if (i__ < *m) { if (i__ < *m) {
a[i__ + i__ * a_dim1] = 1.;
i__1 = *m - i__; i__1 = *m - i__;
i__2 = *n - i__ + 1; i__2 = *n - i__ + 1;
dlarf_((char *)"Right", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda, &tau[i__], dlarf1f_((char *)"R", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda, &tau[i__],
&a[i__ + 1 + i__ * a_dim1], lda, &work[1], (ftnlen)5); &a[i__ + 1 + i__ * a_dim1], lda, &work[1], (ftnlen)1);
} }
i__1 = *n - i__; i__1 = *n - i__;
d__1 = -tau[i__]; d__1 = -tau[i__];

10
lib/linalg/dorglq.cpp
View File

@ -100,13 +100,13 @@ int dorglq_(integer *m, integer *n, integer *k, doublereal *a, integer *lda, dou
ib = min(i__2, i__3); ib = min(i__2, i__3);
if (i__ + ib <= *m) { if (i__ + ib <= *m) {
i__2 = *n - i__ + 1; i__2 = *n - i__ + 1;
dlarft_((char *)"Forward", (char *)"Rowwise", &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], dlarft_((char *)"F", (char *)"R", &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1],
&work[1], &ldwork, (ftnlen)7, (ftnlen)7); &ldwork, (ftnlen)1, (ftnlen)1);
i__2 = *m - i__ - ib + 1; i__2 = *m - i__ - ib + 1;
i__3 = *n - i__ + 1; i__3 = *n - i__ + 1;
dlarfb_((char *)"Right", (char *)"Transpose", (char *)"Forward", (char *)"Rowwise", &i__2, &i__3, &ib, dlarfb_((char *)"R", (char *)"T", (char *)"F", (char *)"R", &i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda,
&a[i__ + i__ * a_dim1], lda, &work[1], &ldwork, &a[i__ + ib + i__ * a_dim1], &work[1], &ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib + 1], &ldwork,
lda, &work[ib + 1], &ldwork, (ftnlen)5, (ftnlen)9, (ftnlen)7, (ftnlen)7); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
i__2 = *n - i__ + 1; i__2 = *n - i__ + 1;
dorgl2_(&ib, &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo); dorgl2_(&ib, &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo);

10
lib/linalg/dorgql.cpp
View File

@ -103,13 +103,13 @@ int dorgql_(integer *m, integer *n, integer *k, doublereal *a, integer *lda, dou
ib = min(i__3, i__4); ib = min(i__3, i__4);
if (*n - *k + i__ > 1) { if (*n - *k + i__ > 1) {
i__3 = *m - *k + i__ + ib - 1; i__3 = *m - *k + i__ + ib - 1;
dlarft_((char *)"Backward", (char *)"Columnwise", &i__3, &ib, &a[(*n - *k + i__) * a_dim1 + 1], lda, dlarft_((char *)"B", (char *)"C", &i__3, &ib, &a[(*n - *k + i__) * a_dim1 + 1], lda, &tau[i__],
&tau[i__], &work[1], &ldwork, (ftnlen)8, (ftnlen)10); &work[1], &ldwork, (ftnlen)1, (ftnlen)1);
i__3 = *m - *k + i__ + ib - 1; i__3 = *m - *k + i__ + ib - 1;
i__4 = *n - *k + i__ - 1; i__4 = *n - *k + i__ - 1;
dlarfb_((char *)"Left", (char *)"No transpose", (char *)"Backward", (char *)"Columnwise", &i__3, &i__4, &ib, dlarfb_((char *)"L", (char *)"N", (char *)"B", (char *)"C", &i__3, &i__4, &ib, &a[(*n - *k + i__) * a_dim1 + 1],
&a[(*n - *k + i__) * a_dim1 + 1], lda, &work[1], &ldwork, &a[a_offset], lda, lda, &work[1], &ldwork, &a[a_offset], lda, &work[ib + 1], &ldwork,
&work[ib + 1], &ldwork, (ftnlen)4, (ftnlen)12, (ftnlen)8, (ftnlen)10); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
i__3 = *m - *k + i__ + ib - 1; i__3 = *m - *k + i__ + ib - 1;
dorg2l_(&i__3, &ib, &ib, &a[(*n - *k + i__) * a_dim1 + 1], lda, &tau[i__], &work[1], dorg2l_(&i__3, &ib, &ib, &a[(*n - *k + i__) * a_dim1 + 1], lda, &tau[i__], &work[1],

11
lib/linalg/dorgqr.cpp
View File

@ -100,14 +100,13 @@ int dorgqr_(integer *m, integer *n, integer *k, doublereal *a, integer *lda, dou
ib = min(i__2, i__3); ib = min(i__2, i__3);
if (i__ + ib <= *n) { if (i__ + ib <= *n) {
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
dlarft_((char *)"Forward", (char *)"Columnwise", &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], dlarft_((char *)"F", (char *)"C", &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1],
&work[1], &ldwork, (ftnlen)7, (ftnlen)10); &ldwork, (ftnlen)1, (ftnlen)1);
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
i__3 = *n - i__ - ib + 1; i__3 = *n - i__ - ib + 1;
dlarfb_((char *)"Left", (char *)"No transpose", (char *)"Forward", (char *)"Columnwise", &i__2, &i__3, &ib, dlarfb_((char *)"L", (char *)"N", (char *)"F", (char *)"C", &i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda,
&a[i__ + i__ * a_dim1], lda, &work[1], &ldwork, &work[1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &work[ib + 1],
&a[i__ + (i__ + ib) * a_dim1], lda, &work[ib + 1], &ldwork, (ftnlen)4, &ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)12, (ftnlen)7, (ftnlen)10);
} }
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
dorg2r_(&i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo); dorg2r_(&i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo);

10
lib/linalg/dorm2l.cpp
View File

@ -9,13 +9,12 @@ int dorm2l_(char *side, char *trans, integer *m, integer *n, integer *k, doubler
{ {
integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2; integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
integer i__, i1, i2, i3, mi, ni, nq; integer i__, i1, i2, i3, mi, ni, nq;
doublereal aii;
logical left; logical left;
extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, doublereal *, ftnlen);
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern int xerbla_(char *, integer *, ftnlen); extern int xerbla_(char *, integer *, ftnlen);
logical notran; logical notran;
extern int dlarf1l_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, doublereal *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -77,11 +76,8 @@ int dorm2l_(char *side, char *trans, integer *m, integer *n, integer *k, doubler
} else { } else {
ni = *n - *k + i__; ni = *n - *k + i__;
} }
aii = a[nq - *k + i__ + i__ * a_dim1]; dlarf1l_(side, &mi, &ni, &a[i__ * a_dim1 + 1], &c__1, &tau[i__], &c__[c_offset], ldc,
a[nq - *k + i__ + i__ * a_dim1] = 1.;
dlarf_(side, &mi, &ni, &a[i__ * a_dim1 + 1], &c__1, &tau[i__], &c__[c_offset], ldc,
&work[1], (ftnlen)1); &work[1], (ftnlen)1);
a[nq - *k + i__ + i__ * a_dim1] = aii;
} }
return 0; return 0;
} }

10
lib/linalg/dorm2r.cpp
View File

@ -9,13 +9,12 @@ int dorm2r_(char *side, char *trans, integer *m, integer *n, integer *k, doubler
{ {
integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2; integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
integer i__, i1, i2, i3, ic, jc, mi, ni, nq; integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
doublereal aii;
logical left; logical left;
extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, doublereal *, ftnlen);
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern int xerbla_(char *, integer *, ftnlen); extern int xerbla_(char *, integer *, ftnlen);
logical notran; logical notran;
extern int dlarf1f_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, doublereal *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -81,11 +80,8 @@ int dorm2r_(char *side, char *trans, integer *m, integer *n, integer *k, doubler
ni = *n - i__ + 1; ni = *n - i__ + 1;
jc = i__; jc = i__;
} }
aii = a[i__ + i__ * a_dim1]; dlarf1f_(side, &mi, &ni, &a[i__ + i__ * a_dim1], &c__1, &tau[i__], &c__[ic + jc * c_dim1],
a[i__ + i__ * a_dim1] = 1.;
dlarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], &c__1, &tau[i__], &c__[ic + jc * c_dim1],
ldc, &work[1], (ftnlen)1); ldc, &work[1], (ftnlen)1);
a[i__ + i__ * a_dim1] = aii;
} }
return 0; return 0;
} }

8
lib/linalg/dormhr.cpp
View File

@ -39,10 +39,10 @@ int dormhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ
lquery = *lwork == -1; lquery = *lwork == -1;
if (left) { if (left) {
nq = *m; nq = *m;
nw = *n; nw = max(1, *n);
} else { } else {
nq = *n; nq = *n;
nw = *m; nw = max(1, *m);
} }
if (!left && !lsame_(side, (char *)"R", (ftnlen)1, (ftnlen)1)) { if (!left && !lsame_(side, (char *)"R", (ftnlen)1, (ftnlen)1)) {
*info = -1; *info = -1;
@ -61,7 +61,7 @@ int dormhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ
*info = -8; *info = -8;
} else if (*ldc < max(1, *m)) { } else if (*ldc < max(1, *m)) {
*info = -11; *info = -11;
} else if (*lwork < max(1, nw) && !lquery) { } else if (*lwork < nw && !lquery) {
*info = -13; *info = -13;
} }
if (*info == 0) { if (*info == 0) {
@ -76,7 +76,7 @@ int dormhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2); s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
nb = ilaenv_(&c__1, (char *)"DORMQR", ch__1, m, &nh, &nh, &c_n1, (ftnlen)6, (ftnlen)2); nb = ilaenv_(&c__1, (char *)"DORMQR", ch__1, m, &nh, &nh, &c_n1, (ftnlen)6, (ftnlen)2);
} }
lwkopt = max(1, nw) * nb; lwkopt = nw * nb;
work[1] = (doublereal)lwkopt; work[1] = (doublereal)lwkopt;
} }
if (*info != 0) { if (*info != 0) {

12
lib/linalg/dorml2.cpp
View File

@ -8,13 +8,12 @@ int dorml2_(char *side, char *trans, integer *m, integer *n, integer *k, doubler
{ {
integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2; integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
integer i__, i1, i2, i3, ic, jc, mi, ni, nq; integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
doublereal aii;
logical left; logical left;
extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, doublereal *, ftnlen);
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern int xerbla_(char *, integer *, ftnlen); extern int xerbla_(char *, integer *, ftnlen);
logical notran; logical notran;
extern int dlarf1f_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, doublereal *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -80,11 +79,8 @@ int dorml2_(char *side, char *trans, integer *m, integer *n, integer *k, doubler
ni = *n - i__ + 1; ni = *n - i__ + 1;
jc = i__; jc = i__;
} }
aii = a[i__ + i__ * a_dim1]; dlarf1f_(side, &mi, &ni, &a[i__ + i__ * a_dim1], lda, &tau[i__], &c__[ic + jc * c_dim1],
a[i__ + i__ * a_dim1] = 1.; ldc, &work[1], (ftnlen)1);
dlarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], lda, &tau[i__], &c__[ic + jc * c_dim1], ldc,
&work[1], (ftnlen)1);
a[i__ + i__ * a_dim1] = aii;
} }
return 0; return 0;
} }

10
lib/linalg/dormlq.cpp
View File

@ -134,8 +134,8 @@ int dormlq_(char *side, char *trans, integer *m, integer *n, integer *k, doubler
i__4 = nb, i__5 = *k - i__ + 1; i__4 = nb, i__5 = *k - i__ + 1;
ib = min(i__4, i__5); ib = min(i__4, i__5);
i__4 = nq - i__ + 1; i__4 = nq - i__ + 1;
dlarft_((char *)"Forward", (char *)"Rowwise", &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], dlarft_((char *)"F", (char *)"R", &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[iwt],
&work[iwt], &c__65, (ftnlen)7, (ftnlen)7); &c__65, (ftnlen)1, (ftnlen)1);
if (left) { if (left) {
mi = *m - i__ + 1; mi = *m - i__ + 1;
ic = i__; ic = i__;
@ -143,9 +143,9 @@ int dormlq_(char *side, char *trans, integer *m, integer *n, integer *k, doubler
ni = *n - i__ + 1; ni = *n - i__ + 1;
jc = i__; jc = i__;
} }
dlarfb_(side, transt, (char *)"Forward", (char *)"Rowwise", &mi, &ni, &ib, &a[i__ + i__ * a_dim1], lda, dlarfb_(side, transt, (char *)"F", (char *)"R", &mi, &ni, &ib, &a[i__ + i__ * a_dim1], lda, &work[iwt],
&work[iwt], &c__65, &c__[ic + jc * c_dim1], ldc, &work[1], &ldwork, (ftnlen)1, &c__65, &c__[ic + jc * c_dim1], ldc, &work[1], &ldwork, (ftnlen)1, (ftnlen)1,
(ftnlen)1, (ftnlen)7, (ftnlen)7); (ftnlen)1, (ftnlen)1);
} }
} }
work[1] = (doublereal)lwkopt; work[1] = (doublereal)lwkopt;

10
lib/linalg/dormql.cpp
View File

@ -128,16 +128,16 @@ int dormql_(char *side, char *trans, integer *m, integer *n, integer *k, doubler
i__4 = nb, i__5 = *k - i__ + 1; i__4 = nb, i__5 = *k - i__ + 1;
ib = min(i__4, i__5); ib = min(i__4, i__5);
i__4 = nq - *k + i__ + ib - 1; i__4 = nq - *k + i__ + ib - 1;
dlarft_((char *)"Backward", (char *)"Columnwise", &i__4, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], dlarft_((char *)"B", (char *)"C", &i__4, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], &work[iwt], &c__65,
&work[iwt], &c__65, (ftnlen)8, (ftnlen)10); (ftnlen)1, (ftnlen)1);
if (left) { if (left) {
mi = *m - *k + i__ + ib - 1; mi = *m - *k + i__ + ib - 1;
} else { } else {
ni = *n - *k + i__ + ib - 1; ni = *n - *k + i__ + ib - 1;
} }
dlarfb_(side, trans, (char *)"Backward", (char *)"Columnwise", &mi, &ni, &ib, &a[i__ * a_dim1 + 1], lda, dlarfb_(side, trans, (char *)"B", (char *)"C", &mi, &ni, &ib, &a[i__ * a_dim1 + 1], lda, &work[iwt],
&work[iwt], &c__65, &c__[c_offset], ldc, &work[1], &ldwork, (ftnlen)1, &c__65, &c__[c_offset], ldc, &work[1], &ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)1, (ftnlen)8, (ftnlen)10); (ftnlen)1);
} }
} }
work[1] = (doublereal)lwkopt; work[1] = (doublereal)lwkopt;

10
lib/linalg/dormqr.cpp
View File

@ -127,8 +127,8 @@ int dormqr_(char *side, char *trans, integer *m, integer *n, integer *k, doubler
i__4 = nb, i__5 = *k - i__ + 1; i__4 = nb, i__5 = *k - i__ + 1;
ib = min(i__4, i__5); ib = min(i__4, i__5);
i__4 = nq - i__ + 1; i__4 = nq - i__ + 1;
dlarft_((char *)"Forward", (char *)"Columnwise", &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], dlarft_((char *)"F", (char *)"C", &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[iwt],
&work[iwt], &c__65, (ftnlen)7, (ftnlen)10); &c__65, (ftnlen)1, (ftnlen)1);
if (left) { if (left) {
mi = *m - i__ + 1; mi = *m - i__ + 1;
ic = i__; ic = i__;
@ -136,9 +136,9 @@ int dormqr_(char *side, char *trans, integer *m, integer *n, integer *k, doubler
ni = *n - i__ + 1; ni = *n - i__ + 1;
jc = i__; jc = i__;
} }
dlarfb_(side, trans, (char *)"Forward", (char *)"Columnwise", &mi, &ni, &ib, &a[i__ + i__ * a_dim1], dlarfb_(side, trans, (char *)"F", (char *)"C", &mi, &ni, &ib, &a[i__ + i__ * a_dim1], lda, &work[iwt],
lda, &work[iwt], &c__65, &c__[ic + jc * c_dim1], ldc, &work[1], &ldwork, &c__65, &c__[ic + jc * c_dim1], ldc, &work[1], &ldwork, (ftnlen)1, (ftnlen)1,
(ftnlen)1, (ftnlen)1, (ftnlen)7, (ftnlen)10); (ftnlen)1, (ftnlen)1);
} }
} }
work[1] = (doublereal)lwkopt; work[1] = (doublereal)lwkopt;

8
lib/linalg/dpotf2.cpp
View File

@ -55,8 +55,8 @@ int dpotf2_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info,
if (j < *n) { if (j < *n) {
i__2 = j - 1; i__2 = j - 1;
i__3 = *n - j; i__3 = *n - j;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b10, &a[(j + 1) * a_dim1 + 1], lda, dgemv_((char *)"T", &i__2, &i__3, &c_b10, &a[(j + 1) * a_dim1 + 1], lda, &a[j * a_dim1 + 1],
&a[j * a_dim1 + 1], &c__1, &c_b12, &a[j + (j + 1) * a_dim1], lda, (ftnlen)9); &c__1, &c_b12, &a[j + (j + 1) * a_dim1], lda, (ftnlen)1);
i__2 = *n - j; i__2 = *n - j;
d__1 = 1. / ajj; d__1 = 1. / ajj;
dscal_(&i__2, &d__1, &a[j + (j + 1) * a_dim1], lda); dscal_(&i__2, &d__1, &a[j + (j + 1) * a_dim1], lda);
@ -76,8 +76,8 @@ int dpotf2_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info,
if (j < *n) { if (j < *n) {
i__2 = *n - j; i__2 = *n - j;
i__3 = j - 1; i__3 = j - 1;
dgemv_((char *)"No transpose", &i__2, &i__3, &c_b10, &a[j + 1 + a_dim1], lda, dgemv_((char *)"N", &i__2, &i__3, &c_b10, &a[j + 1 + a_dim1], lda, &a[j + a_dim1], lda,
&a[j + a_dim1], lda, &c_b12, &a[j + 1 + j * a_dim1], &c__1, (ftnlen)12); &c_b12, &a[j + 1 + j * a_dim1], &c__1, (ftnlen)1);
i__2 = *n - j; i__2 = *n - j;
d__1 = 1. / ajj; d__1 = 1. / ajj;
dscal_(&i__2, &d__1, &a[j + 1 + j * a_dim1], &c__1); dscal_(&i__2, &d__1, &a[j + 1 + j * a_dim1], &c__1);

36
lib/linalg/dpotrf.cpp
View File

@ -55,22 +55,22 @@ int dpotrf_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info,
i__3 = nb, i__4 = *n - j + 1; i__3 = nb, i__4 = *n - j + 1;
jb = min(i__3, i__4); jb = min(i__3, i__4);
i__3 = j - 1; i__3 = j - 1;
dsyrk_((char *)"Upper", (char *)"Transpose", &jb, &i__3, &c_b13, &a[j * a_dim1 + 1], lda, &c_b14, dsyrk_((char *)"U", (char *)"T", &jb, &i__3, &c_b13, &a[j * a_dim1 + 1], lda, &c_b14,
&a[j + j * a_dim1], lda, (ftnlen)5, (ftnlen)9); &a[j + j * a_dim1], lda, (ftnlen)1, (ftnlen)1);
dpotrf2_((char *)"Upper", &jb, &a[j + j * a_dim1], lda, info, (ftnlen)5); dpotrf2_((char *)"U", &jb, &a[j + j * a_dim1], lda, info, (ftnlen)1);
if (*info != 0) { if (*info != 0) {
goto L30; goto L30;
} }
if (j + jb <= *n) { if (j + jb <= *n) {
i__3 = *n - j - jb + 1; i__3 = *n - j - jb + 1;
i__4 = j - 1; i__4 = j - 1;
dgemm_((char *)"Transpose", (char *)"No transpose", &jb, &i__3, &i__4, &c_b13, dgemm_((char *)"T", (char *)"N", &jb, &i__3, &i__4, &c_b13, &a[j * a_dim1 + 1], lda,
&a[j * a_dim1 + 1], lda, &a[(j + jb) * a_dim1 + 1], lda, &c_b14, &a[(j + jb) * a_dim1 + 1], lda, &c_b14, &a[j + (j + jb) * a_dim1], lda,
&a[j + (j + jb) * a_dim1], lda, (ftnlen)9, (ftnlen)12); (ftnlen)1, (ftnlen)1);
i__3 = *n - j - jb + 1; i__3 = *n - j - jb + 1;
dtrsm_((char *)"Left", (char *)"Upper", (char *)"Transpose", (char *)"Non-unit", &jb, &i__3, &c_b14, dtrsm_((char *)"L", (char *)"U", (char *)"T", (char *)"N", &jb, &i__3, &c_b14, &a[j + j * a_dim1], lda,
&a[j + j * a_dim1], lda, &a[j + (j + jb) * a_dim1], lda, (ftnlen)4, &a[j + (j + jb) * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)5, (ftnlen)9, (ftnlen)8); (ftnlen)1);
} }
} }
} else { } else {
@ -80,22 +80,22 @@ int dpotrf_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info,
i__3 = nb, i__4 = *n - j + 1; i__3 = nb, i__4 = *n - j + 1;
jb = min(i__3, i__4); jb = min(i__3, i__4);
i__3 = j - 1; i__3 = j - 1;
dsyrk_((char *)"Lower", (char *)"No transpose", &jb, &i__3, &c_b13, &a[j + a_dim1], lda, &c_b14, dsyrk_((char *)"L", (char *)"N", &jb, &i__3, &c_b13, &a[j + a_dim1], lda, &c_b14,
&a[j + j * a_dim1], lda, (ftnlen)5, (ftnlen)12); &a[j + j * a_dim1], lda, (ftnlen)1, (ftnlen)1);
dpotrf2_((char *)"Lower", &jb, &a[j + j * a_dim1], lda, info, (ftnlen)5); dpotrf2_((char *)"L", &jb, &a[j + j * a_dim1], lda, info, (ftnlen)1);
if (*info != 0) { if (*info != 0) {
goto L30; goto L30;
} }
if (j + jb <= *n) { if (j + jb <= *n) {
i__3 = *n - j - jb + 1; i__3 = *n - j - jb + 1;
i__4 = j - 1; i__4 = j - 1;
dgemm_((char *)"No transpose", (char *)"Transpose", &i__3, &jb, &i__4, &c_b13, dgemm_((char *)"N", (char *)"T", &i__3, &jb, &i__4, &c_b13, &a[j + jb + a_dim1], lda,
&a[j + jb + a_dim1], lda, &a[j + a_dim1], lda, &c_b14, &a[j + a_dim1], lda, &c_b14, &a[j + jb + j * a_dim1], lda, (ftnlen)1,
&a[j + jb + j * a_dim1], lda, (ftnlen)12, (ftnlen)9); (ftnlen)1);
i__3 = *n - j - jb + 1; i__3 = *n - j - jb + 1;
dtrsm_((char *)"Right", (char *)"Lower", (char *)"Transpose", (char *)"Non-unit", &i__3, &jb, &c_b14, dtrsm_((char *)"R", (char *)"L", (char *)"T", (char *)"N", &i__3, &jb, &c_b14, &a[j + j * a_dim1], lda,
&a[j + j * a_dim1], lda, &a[j + jb + j * a_dim1], lda, (ftnlen)5, &a[j + jb + j * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)5, (ftnlen)9, (ftnlen)8); (ftnlen)1);
} }
} }
} }

2
lib/linalg/dpotri.cpp
View File

@ -28,7 +28,7 @@ int dpotri_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info,
if (*n == 0) { if (*n == 0) {
return 0; return 0;
} }
dtrtri_(uplo, (char *)"Non-unit", n, &a[a_offset], lda, info, (ftnlen)1, (ftnlen)8); dtrtri_(uplo, (char *)"N", n, &a[a_offset], lda, info, (ftnlen)1, (ftnlen)1);
if (*info > 0) { if (*info > 0) {
return 0; return 0;
} }

16
lib/linalg/dpotrs.cpp
View File

@ -41,15 +41,15 @@ int dpotrs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda,
return 0; return 0;
} }
if (upper) { if (upper) {
dtrsm_((char *)"Left", (char *)"Upper", (char *)"Transpose", (char *)"Non-unit", n, nrhs, &c_b9, &a[a_offset], lda, dtrsm_((char *)"L", (char *)"U", (char *)"T", (char *)"N", n, nrhs, &c_b9, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
&b[b_offset], ldb, (ftnlen)4, (ftnlen)5, (ftnlen)9, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1);
dtrsm_((char *)"Left", (char *)"Upper", (char *)"No transpose", (char *)"Non-unit", n, nrhs, &c_b9, &a[a_offset], lda, dtrsm_((char *)"L", (char *)"U", (char *)"N", (char *)"N", n, nrhs, &c_b9, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
&b[b_offset], ldb, (ftnlen)4, (ftnlen)5, (ftnlen)12, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1);
} else { } else {
dtrsm_((char *)"Left", (char *)"Lower", (char *)"No transpose", (char *)"Non-unit", n, nrhs, &c_b9, &a[a_offset], lda, dtrsm_((char *)"L", (char *)"L", (char *)"N", (char *)"N", n, nrhs, &c_b9, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
&b[b_offset], ldb, (ftnlen)4, (ftnlen)5, (ftnlen)12, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1);
dtrsm_((char *)"Left", (char *)"Lower", (char *)"Transpose", (char *)"Non-unit", n, nrhs, &c_b9, &a[a_offset], lda, dtrsm_((char *)"L", (char *)"L", (char *)"T", (char *)"N", n, nrhs, &c_b9, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
&b[b_offset], ldb, (ftnlen)4, (ftnlen)5, (ftnlen)9, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
return 0; return 0;
} }

2
lib/linalg/dstedc.cpp
View File

@ -138,7 +138,7 @@ int dstedc_(char *compz, integer *n, doublereal *d__, doublereal *e, doublereal
storez = 1; storez = 1;
} }
if (icompz == 2) { if (icompz == 2) {
dlaset_((char *)"Full", n, n, &c_b17, &c_b18, &z__[z_offset], ldz, (ftnlen)4); dlaset_((char *)"F", n, n, &c_b17, &c_b18, &z__[z_offset], ldz, (ftnlen)1);
} }
orgnrm = dlanst_((char *)"M", n, &d__[1], &e[1], (ftnlen)1); orgnrm = dlanst_((char *)"M", n, &d__[1], &e[1], (ftnlen)1);
if (orgnrm == 0.) { if (orgnrm == 0.) {

2
lib/linalg/dsteqr.cpp
View File

@ -91,7 +91,7 @@ int dsteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublereal
ssfmax = sqrt(safmax) / 3.; ssfmax = sqrt(safmax) / 3.;
ssfmin = sqrt(safmin) / eps2; ssfmin = sqrt(safmin) / eps2;
if (icompz == 2) { if (icompz == 2) {
dlaset_((char *)"Full", n, n, &c_b9, &c_b10, &z__[z_offset], ldz, (ftnlen)4); dlaset_((char *)"F", n, n, &c_b9, &c_b10, &z__[z_offset], ldz, (ftnlen)1);
} }
nmaxit = *n * 30; nmaxit = *n * 30;
jtot = 0; jtot = 0;

16
lib/linalg/dsygs2.cpp
View File

@ -72,8 +72,8 @@ int dsygs2_(integer *itype, char *uplo, integer *n, doublereal *a, integer *lda,
daxpy_(&i__2, &ct, &b[k + (k + 1) * b_dim1], ldb, &a[k + (k + 1) * a_dim1], daxpy_(&i__2, &ct, &b[k + (k + 1) * b_dim1], ldb, &a[k + (k + 1) * a_dim1],
lda); lda);
i__2 = *n - k; i__2 = *n - k;
dtrsv_(uplo, (char *)"Transpose", (char *)"Non-unit", &i__2, &b[k + 1 + (k + 1) * b_dim1], ldb, dtrsv_(uplo, (char *)"T", (char *)"N", &i__2, &b[k + 1 + (k + 1) * b_dim1], ldb,
&a[k + (k + 1) * a_dim1], lda, (ftnlen)1, (ftnlen)9, (ftnlen)8); &a[k + (k + 1) * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
} }
} else { } else {
@ -100,8 +100,8 @@ int dsygs2_(integer *itype, char *uplo, integer *n, doublereal *a, integer *lda,
daxpy_(&i__2, &ct, &b[k + 1 + k * b_dim1], &c__1, &a[k + 1 + k * a_dim1], daxpy_(&i__2, &ct, &b[k + 1 + k * b_dim1], &c__1, &a[k + 1 + k * a_dim1],
&c__1); &c__1);
i__2 = *n - k; i__2 = *n - k;
dtrsv_(uplo, (char *)"No transpose", (char *)"Non-unit", &i__2, &b[k + 1 + (k + 1) * b_dim1], dtrsv_(uplo, (char *)"N", (char *)"N", &i__2, &b[k + 1 + (k + 1) * b_dim1], ldb,
ldb, &a[k + 1 + k * a_dim1], &c__1, (ftnlen)1, (ftnlen)12, (ftnlen)8); &a[k + 1 + k * a_dim1], &c__1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
} }
} }
@ -112,8 +112,8 @@ int dsygs2_(integer *itype, char *uplo, integer *n, doublereal *a, integer *lda,
akk = a[k + k * a_dim1]; akk = a[k + k * a_dim1];
bkk = b[k + k * b_dim1]; bkk = b[k + k * b_dim1];
i__2 = k - 1; i__2 = k - 1;
dtrmv_(uplo, (char *)"No transpose", (char *)"Non-unit", &i__2, &b[b_offset], ldb, dtrmv_(uplo, (char *)"N", (char *)"N", &i__2, &b[b_offset], ldb, &a[k * a_dim1 + 1], &c__1,
&a[k * a_dim1 + 1], &c__1, (ftnlen)1, (ftnlen)12, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1);
ct = akk * .5; ct = akk * .5;
i__2 = k - 1; i__2 = k - 1;
daxpy_(&i__2, &ct, &b[k * b_dim1 + 1], &c__1, &a[k * a_dim1 + 1], &c__1); daxpy_(&i__2, &ct, &b[k * b_dim1 + 1], &c__1, &a[k * a_dim1 + 1], &c__1);
@ -133,8 +133,8 @@ int dsygs2_(integer *itype, char *uplo, integer *n, doublereal *a, integer *lda,
akk = a[k + k * a_dim1]; akk = a[k + k * a_dim1];
bkk = b[k + k * b_dim1]; bkk = b[k + k * b_dim1];
i__2 = k - 1; i__2 = k - 1;
dtrmv_(uplo, (char *)"Transpose", (char *)"Non-unit", &i__2, &b[b_offset], ldb, &a[k + a_dim1], lda, dtrmv_(uplo, (char *)"T", (char *)"N", &i__2, &b[b_offset], ldb, &a[k + a_dim1], lda, (ftnlen)1,
(ftnlen)1, (ftnlen)9, (ftnlen)8); (ftnlen)1, (ftnlen)1);
ct = akk * .5; ct = akk * .5;
i__2 = k - 1; i__2 = k - 1;
daxpy_(&i__2, &ct, &b[k + b_dim1], ldb, &a[k + a_dim1], lda); daxpy_(&i__2, &ct, &b[k + b_dim1], ldb, &a[k + a_dim1], lda);

94
lib/linalg/dsygst.cpp
View File

@ -72,25 +72,25 @@ int dsygst_(integer *itype, char *uplo, integer *n, doublereal *a, integer *lda,
info, (ftnlen)1); info, (ftnlen)1);
if (k + kb <= *n) { if (k + kb <= *n) {
i__3 = *n - k - kb + 1; i__3 = *n - k - kb + 1;
dtrsm_((char *)"Left", uplo, (char *)"Transpose", (char *)"Non-unit", &kb, &i__3, &c_b14, dtrsm_((char *)"L", uplo, (char *)"T", (char *)"N", &kb, &i__3, &c_b14, &b[k + k * b_dim1], ldb,
&b[k + k * b_dim1], ldb, &a[k + (k + kb) * a_dim1], lda, (ftnlen)4, &a[k + (k + kb) * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)1, (ftnlen)9, (ftnlen)8); (ftnlen)1);
i__3 = *n - k - kb + 1; i__3 = *n - k - kb + 1;
dsymm_((char *)"Left", uplo, &kb, &i__3, &c_b16, &a[k + k * a_dim1], lda, dsymm_((char *)"L", uplo, &kb, &i__3, &c_b16, &a[k + k * a_dim1], lda,
&b[k + (k + kb) * b_dim1], ldb, &c_b14, &a[k + (k + kb) * a_dim1], &b[k + (k + kb) * b_dim1], ldb, &c_b14, &a[k + (k + kb) * a_dim1],
lda, (ftnlen)4, (ftnlen)1); lda, (ftnlen)1, (ftnlen)1);
i__3 = *n - k - kb + 1; i__3 = *n - k - kb + 1;
dsyr2k_(uplo, (char *)"Transpose", &i__3, &kb, &c_b19, &a[k + (k + kb) * a_dim1], dsyr2k_(uplo, (char *)"T", &i__3, &kb, &c_b19, &a[k + (k + kb) * a_dim1], lda,
lda, &b[k + (k + kb) * b_dim1], ldb, &c_b14, &b[k + (k + kb) * b_dim1], ldb, &c_b14,
&a[k + kb + (k + kb) * a_dim1], lda, (ftnlen)1, (ftnlen)9); &a[k + kb + (k + kb) * a_dim1], lda, (ftnlen)1, (ftnlen)1);
i__3 = *n - k - kb + 1; i__3 = *n - k - kb + 1;
dsymm_((char *)"Left", uplo, &kb, &i__3, &c_b16, &a[k + k * a_dim1], lda, dsymm_((char *)"L", uplo, &kb, &i__3, &c_b16, &a[k + k * a_dim1], lda,
&b[k + (k + kb) * b_dim1], ldb, &c_b14, &a[k + (k + kb) * a_dim1], &b[k + (k + kb) * b_dim1], ldb, &c_b14, &a[k + (k + kb) * a_dim1],
lda, (ftnlen)4, (ftnlen)1); lda, (ftnlen)1, (ftnlen)1);
i__3 = *n - k - kb + 1; i__3 = *n - k - kb + 1;
dtrsm_((char *)"Right", uplo, (char *)"No transpose", (char *)"Non-unit", &kb, &i__3, &c_b14, dtrsm_((char *)"R", uplo, (char *)"N", (char *)"N", &kb, &i__3, &c_b14,
&b[k + kb + (k + kb) * b_dim1], ldb, &a[k + (k + kb) * a_dim1], lda, &b[k + kb + (k + kb) * b_dim1], ldb, &a[k + (k + kb) * a_dim1], lda,
(ftnlen)5, (ftnlen)1, (ftnlen)12, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
} }
} else { } else {
@ -103,25 +103,25 @@ int dsygst_(integer *itype, char *uplo, integer *n, doublereal *a, integer *lda,
info, (ftnlen)1); info, (ftnlen)1);
if (k + kb <= *n) { if (k + kb <= *n) {
i__3 = *n - k - kb + 1; i__3 = *n - k - kb + 1;
dtrsm_((char *)"Right", uplo, (char *)"Transpose", (char *)"Non-unit", &i__3, &kb, &c_b14, dtrsm_((char *)"R", uplo, (char *)"T", (char *)"N", &i__3, &kb, &c_b14, &b[k + k * b_dim1], ldb,
&b[k + k * b_dim1], ldb, &a[k + kb + k * a_dim1], lda, (ftnlen)5, &a[k + kb + k * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)1, (ftnlen)9, (ftnlen)8); (ftnlen)1);
i__3 = *n - k - kb + 1; i__3 = *n - k - kb + 1;
dsymm_((char *)"Right", uplo, &i__3, &kb, &c_b16, &a[k + k * a_dim1], lda, dsymm_((char *)"R", uplo, &i__3, &kb, &c_b16, &a[k + k * a_dim1], lda,
&b[k + kb + k * b_dim1], ldb, &c_b14, &a[k + kb + k * a_dim1], lda, &b[k + kb + k * b_dim1], ldb, &c_b14, &a[k + kb + k * a_dim1], lda,
(ftnlen)5, (ftnlen)1); (ftnlen)1, (ftnlen)1);
i__3 = *n - k - kb + 1; i__3 = *n - k - kb + 1;
dsyr2k_(uplo, (char *)"No transpose", &i__3, &kb, &c_b19, &a[k + kb + k * a_dim1], dsyr2k_(uplo, (char *)"N", &i__3, &kb, &c_b19, &a[k + kb + k * a_dim1], lda,
lda, &b[k + kb + k * b_dim1], ldb, &c_b14, &b[k + kb + k * b_dim1], ldb, &c_b14,
&a[k + kb + (k + kb) * a_dim1], lda, (ftnlen)1, (ftnlen)12); &a[k + kb + (k + kb) * a_dim1], lda, (ftnlen)1, (ftnlen)1);
i__3 = *n - k - kb + 1; i__3 = *n - k - kb + 1;
dsymm_((char *)"Right", uplo, &i__3, &kb, &c_b16, &a[k + k * a_dim1], lda, dsymm_((char *)"R", uplo, &i__3, &kb, &c_b16, &a[k + k * a_dim1], lda,
&b[k + kb + k * b_dim1], ldb, &c_b14, &a[k + kb + k * a_dim1], lda, &b[k + kb + k * b_dim1], ldb, &c_b14, &a[k + kb + k * a_dim1], lda,
(ftnlen)5, (ftnlen)1); (ftnlen)1, (ftnlen)1);
i__3 = *n - k - kb + 1; i__3 = *n - k - kb + 1;
dtrsm_((char *)"Left", uplo, (char *)"No transpose", (char *)"Non-unit", &i__3, &kb, &c_b14, dtrsm_((char *)"L", uplo, (char *)"N", (char *)"N", &i__3, &kb, &c_b14,
&b[k + kb + (k + kb) * b_dim1], ldb, &a[k + kb + k * a_dim1], lda, &b[k + kb + (k + kb) * b_dim1], ldb, &a[k + kb + k * a_dim1], lda,
(ftnlen)4, (ftnlen)1, (ftnlen)12, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
} }
} }
@ -133,25 +133,23 @@ int dsygst_(integer *itype, char *uplo, integer *n, doublereal *a, integer *lda,
i__3 = *n - k + 1; i__3 = *n - k + 1;
kb = min(i__3, nb); kb = min(i__3, nb);
i__3 = k - 1; i__3 = k - 1;
dtrmm_((char *)"Left", uplo, (char *)"No transpose", (char *)"Non-unit", &i__3, &kb, &c_b14, dtrmm_((char *)"L", uplo, (char *)"N", (char *)"N", &i__3, &kb, &c_b14, &b[b_offset], ldb,
&b[b_offset], ldb, &a[k * a_dim1 + 1], lda, (ftnlen)4, (ftnlen)1, &a[k * a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)12, (ftnlen)8);
i__3 = k - 1; i__3 = k - 1;
dsymm_((char *)"Right", uplo, &i__3, &kb, &c_b52, &a[k + k * a_dim1], lda, dsymm_((char *)"R", uplo, &i__3, &kb, &c_b52, &a[k + k * a_dim1], lda,
&b[k * b_dim1 + 1], ldb, &c_b14, &a[k * a_dim1 + 1], lda, (ftnlen)5, &b[k * b_dim1 + 1], ldb, &c_b14, &a[k * a_dim1 + 1], lda, (ftnlen)1,
(ftnlen)1); (ftnlen)1);
i__3 = k - 1; i__3 = k - 1;
dsyr2k_(uplo, (char *)"No transpose", &i__3, &kb, &c_b14, &a[k * a_dim1 + 1], lda, dsyr2k_(uplo, (char *)"N", &i__3, &kb, &c_b14, &a[k * a_dim1 + 1], lda,
&b[k * b_dim1 + 1], ldb, &c_b14, &a[a_offset], lda, (ftnlen)1, &b[k * b_dim1 + 1], ldb, &c_b14, &a[a_offset], lda, (ftnlen)1,
(ftnlen)12);
i__3 = k - 1;
dsymm_((char *)"Right", uplo, &i__3, &kb, &c_b52, &a[k + k * a_dim1], lda,
&b[k * b_dim1 + 1], ldb, &c_b14, &a[k * a_dim1 + 1], lda, (ftnlen)5,
(ftnlen)1); (ftnlen)1);
i__3 = k - 1; i__3 = k - 1;
dtrmm_((char *)"Right", uplo, (char *)"Transpose", (char *)"Non-unit", &i__3, &kb, &c_b14, dsymm_((char *)"R", uplo, &i__3, &kb, &c_b52, &a[k + k * a_dim1], lda,
&b[k + k * b_dim1], ldb, &a[k * a_dim1 + 1], lda, (ftnlen)5, (ftnlen)1, &b[k * b_dim1 + 1], ldb, &c_b14, &a[k * a_dim1 + 1], lda, (ftnlen)1,
(ftnlen)9, (ftnlen)8); (ftnlen)1);
i__3 = k - 1;
dtrmm_((char *)"R", uplo, (char *)"T", (char *)"N", &i__3, &kb, &c_b14, &b[k + k * b_dim1], ldb,
&a[k * a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
dsygs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb, dsygs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb,
info, (ftnlen)1); info, (ftnlen)1);
} }
@ -162,22 +160,20 @@ int dsygst_(integer *itype, char *uplo, integer *n, doublereal *a, integer *lda,
i__3 = *n - k + 1; i__3 = *n - k + 1;
kb = min(i__3, nb); kb = min(i__3, nb);
i__3 = k - 1; i__3 = k - 1;
dtrmm_((char *)"Right", uplo, (char *)"No transpose", (char *)"Non-unit", &kb, &i__3, &c_b14, dtrmm_((char *)"R", uplo, (char *)"N", (char *)"N", &kb, &i__3, &c_b14, &b[b_offset], ldb,
&b[b_offset], ldb, &a[k + a_dim1], lda, (ftnlen)5, (ftnlen)1, (ftnlen)12, &a[k + a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)8);
i__3 = k - 1; i__3 = k - 1;
dsymm_((char *)"Left", uplo, &kb, &i__3, &c_b52, &a[k + k * a_dim1], lda, dsymm_((char *)"L", uplo, &kb, &i__3, &c_b52, &a[k + k * a_dim1], lda, &b[k + b_dim1],
&b[k + b_dim1], ldb, &c_b14, &a[k + a_dim1], lda, (ftnlen)4, (ftnlen)1); ldb, &c_b14, &a[k + a_dim1], lda, (ftnlen)1, (ftnlen)1);
i__3 = k - 1; i__3 = k - 1;
dsyr2k_(uplo, (char *)"Transpose", &i__3, &kb, &c_b14, &a[k + a_dim1], lda, dsyr2k_(uplo, (char *)"T", &i__3, &kb, &c_b14, &a[k + a_dim1], lda, &b[k + b_dim1], ldb,
&b[k + b_dim1], ldb, &c_b14, &a[a_offset], lda, (ftnlen)1, (ftnlen)9); &c_b14, &a[a_offset], lda, (ftnlen)1, (ftnlen)1);
i__3 = k - 1; i__3 = k - 1;
dsymm_((char *)"Left", uplo, &kb, &i__3, &c_b52, &a[k + k * a_dim1], lda, dsymm_((char *)"L", uplo, &kb, &i__3, &c_b52, &a[k + k * a_dim1], lda, &b[k + b_dim1],
&b[k + b_dim1], ldb, &c_b14, &a[k + a_dim1], lda, (ftnlen)4, (ftnlen)1); ldb, &c_b14, &a[k + a_dim1], lda, (ftnlen)1, (ftnlen)1);
i__3 = k - 1; i__3 = k - 1;
dtrmm_((char *)"Left", uplo, (char *)"Transpose", (char *)"Non-unit", &kb, &i__3, &c_b14, dtrmm_((char *)"L", uplo, (char *)"T", (char *)"N", &kb, &i__3, &c_b14, &b[k + k * b_dim1], ldb,
&b[k + k * b_dim1], ldb, &a[k + a_dim1], lda, (ftnlen)4, (ftnlen)1, &a[k + a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)9, (ftnlen)8);
dsygs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb, dsygs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb,
info, (ftnlen)1); info, (ftnlen)1);
} }

8
lib/linalg/dsygv.cpp
View File

@ -96,16 +96,16 @@ int dsygv_(integer *itype, char *jobz, char *uplo, integer *n, doublereal *a, in
} else { } else {
*(unsigned char *)trans = 'T'; *(unsigned char *)trans = 'T';
} }
dtrsm_((char *)"Left", uplo, trans, (char *)"Non-unit", n, &neig, &c_b16, &b[b_offset], ldb, dtrsm_((char *)"L", uplo, trans, (char *)"N", n, &neig, &c_b16, &b[b_offset], ldb, &a[a_offset], lda,
&a[a_offset], lda, (ftnlen)4, (ftnlen)1, (ftnlen)1, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} else if (*itype == 3) { } else if (*itype == 3) {
if (upper) { if (upper) {
*(unsigned char *)trans = 'T'; *(unsigned char *)trans = 'T';
} else { } else {
*(unsigned char *)trans = 'N'; *(unsigned char *)trans = 'N';
} }
dtrmm_((char *)"Left", uplo, trans, (char *)"Non-unit", n, &neig, &c_b16, &b[b_offset], ldb, dtrmm_((char *)"L", uplo, trans, (char *)"N", n, &neig, &c_b16, &b[b_offset], ldb, &a[a_offset], lda,
&a[a_offset], lda, (ftnlen)4, (ftnlen)1, (ftnlen)1, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
} }
work[1] = (doublereal)lwkopt; work[1] = (doublereal)lwkopt;

8
lib/linalg/dsygvd.cpp
View File

@ -106,16 +106,16 @@ int dsygvd_(integer *itype, char *jobz, char *uplo, integer *n, doublereal *a, i
} else { } else {
*(unsigned char *)trans = 'T'; *(unsigned char *)trans = 'T';
} }
dtrsm_((char *)"Left", uplo, trans, (char *)"Non-unit", n, n, &c_b11, &b[b_offset], ldb, &a[a_offset], dtrsm_((char *)"L", uplo, trans, (char *)"N", n, n, &c_b11, &b[b_offset], ldb, &a[a_offset], lda,
lda, (ftnlen)4, (ftnlen)1, (ftnlen)1, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} else if (*itype == 3) { } else if (*itype == 3) {
if (upper) { if (upper) {
*(unsigned char *)trans = 'T'; *(unsigned char *)trans = 'T';
} else { } else {
*(unsigned char *)trans = 'N'; *(unsigned char *)trans = 'N';
} }
dtrmm_((char *)"Left", uplo, trans, (char *)"Non-unit", n, n, &c_b11, &b[b_offset], ldb, &a[a_offset], dtrmm_((char *)"L", uplo, trans, (char *)"N", n, n, &c_b11, &b[b_offset], ldb, &a[a_offset], lda,
lda, (ftnlen)4, (ftnlen)1, (ftnlen)1, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
} }
work[1] = (doublereal)lopt; work[1] = (doublereal)lopt;

67
lib/linalg/dsyr.cpp
View File

@ -2,7 +2,6 @@
extern "C" { extern "C" {
#endif #endif
#include "lmp_f2c.h" #include "lmp_f2c.h"
static integer c_n1 = -1;
int dsyr_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *incx, doublereal *a, int dsyr_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *incx, doublereal *a,
integer *lda, ftnlen uplo_len) integer *lda, ftnlen uplo_len)
{ {
@ -96,72 +95,6 @@ int dsyr_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *inc
} }
return 0; return 0;
} }
int dsysv_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv,
doublereal *b, integer *ldb, doublereal *work, integer *lwork, integer *info,
ftnlen uplo_len)
{
integer a_dim1, a_offset, b_dim1, b_offset, i__1;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern int xerbla_(char *, integer *, ftnlen),
dsytrf_(char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *,
integer *, ftnlen);
integer lwkopt;
logical lquery;
extern int dsytrs_(char *, integer *, integer *, doublereal *, integer *, integer *,
doublereal *, integer *, integer *, ftnlen),
dsytrs2_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *,
integer *, doublereal *, integer *, ftnlen);
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--ipiv;
b_dim1 = *ldb;
b_offset = 1 + b_dim1;
b -= b_offset;
--work;
*info = 0;
lquery = *lwork == -1;
if (!lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
*info = -1;
} else if (*n < 0) {
*info = -2;
} else if (*nrhs < 0) {
*info = -3;
} else if (*lda < max(1, *n)) {
*info = -5;
} else if (*ldb < max(1, *n)) {
*info = -8;
} else if (*lwork < 1 && !lquery) {
*info = -10;
}
if (*info == 0) {
if (*n == 0) {
lwkopt = 1;
} else {
dsytrf_(uplo, n, &a[a_offset], lda, &ipiv[1], &work[1], &c_n1, info, (ftnlen)1);
lwkopt = (integer)work[1];
}
work[1] = (doublereal)lwkopt;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_((char *)"DSYSV ", &i__1, (ftnlen)6);
return 0;
} else if (lquery) {
return 0;
}
dsytrf_(uplo, n, &a[a_offset], lda, &ipiv[1], &work[1], lwork, info, (ftnlen)1);
if (*info == 0) {
if (*lwork < *n) {
dsytrs_(uplo, n, nrhs, &a[a_offset], lda, &ipiv[1], &b[b_offset], ldb, info, (ftnlen)1);
} else {
dsytrs2_(uplo, n, nrhs, &a[a_offset], lda, &ipiv[1], &b[b_offset], ldb, &work[1], info,
(ftnlen)1);
}
}
work[1] = (doublereal)lwkopt;
return 0;
}
#ifdef __cplusplus #ifdef __cplusplus
} }
#endif #endif

12
lib/linalg/dsytrd.cpp
View File

@ -48,7 +48,8 @@ int dsytrd_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal *d__
} }
if (*info == 0) { if (*info == 0) {
nb = ilaenv_(&c__1, (char *)"DSYTRD", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); nb = ilaenv_(&c__1, (char *)"DSYTRD", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
lwkopt = *n * nb; i__1 = 1, i__2 = *n * nb;
lwkopt = max(i__1, i__2);
work[1] = (doublereal)lwkopt; work[1] = (doublereal)lwkopt;
} }
if (*info != 0) { if (*info != 0) {
@ -95,8 +96,8 @@ int dsytrd_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal *d__
dlatrd_(uplo, &i__3, &nb, &a[a_offset], lda, &e[1], &tau[1], &work[1], &ldwork, dlatrd_(uplo, &i__3, &nb, &a[a_offset], lda, &e[1], &tau[1], &work[1], &ldwork,
(ftnlen)1); (ftnlen)1);
i__3 = i__ - 1; i__3 = i__ - 1;
dsyr2k_(uplo, (char *)"No transpose", &i__3, &nb, &c_b22, &a[i__ * a_dim1 + 1], lda, &work[1], dsyr2k_(uplo, (char *)"N", &i__3, &nb, &c_b22, &a[i__ * a_dim1 + 1], lda, &work[1], &ldwork,
&ldwork, &c_b23, &a[a_offset], lda, (ftnlen)1, (ftnlen)12); &c_b23, &a[a_offset], lda, (ftnlen)1, (ftnlen)1);
i__3 = i__ + nb - 1; i__3 = i__ + nb - 1;
for (j = i__; j <= i__3; ++j) { for (j = i__; j <= i__3; ++j) {
a[j - 1 + j * a_dim1] = e[j - 1]; a[j - 1 + j * a_dim1] = e[j - 1];
@ -112,9 +113,8 @@ int dsytrd_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal *d__
dlatrd_(uplo, &i__3, &nb, &a[i__ + i__ * a_dim1], lda, &e[i__], &tau[i__], &work[1], dlatrd_(uplo, &i__3, &nb, &a[i__ + i__ * a_dim1], lda, &e[i__], &tau[i__], &work[1],
&ldwork, (ftnlen)1); &ldwork, (ftnlen)1);
i__3 = *n - i__ - nb + 1; i__3 = *n - i__ - nb + 1;
dsyr2k_(uplo, (char *)"No transpose", &i__3, &nb, &c_b22, &a[i__ + nb + i__ * a_dim1], lda, dsyr2k_(uplo, (char *)"N", &i__3, &nb, &c_b22, &a[i__ + nb + i__ * a_dim1], lda, &work[nb + 1],
&work[nb + 1], &ldwork, &c_b23, &a[i__ + nb + (i__ + nb) * a_dim1], lda, &ldwork, &c_b23, &a[i__ + nb + (i__ + nb) * a_dim1], lda, (ftnlen)1, (ftnlen)1);
(ftnlen)1, (ftnlen)12);
i__3 = i__ + nb - 1; i__3 = i__ + nb - 1;
for (j = i__; j <= i__3; ++j) { for (j = i__; j <= i__3; ++j) {
a[j + 1 + j * a_dim1] = e[j]; a[j + 1 + j * a_dim1] = e[j];

3
lib/linalg/dsytrf.cpp
View File

@ -40,7 +40,8 @@ int dsytrf_(char *uplo, integer *n, doublereal *a, integer *lda, integer *ipiv,
} }
if (*info == 0) { if (*info == 0) {
nb = ilaenv_(&c__1, (char *)"DSYTRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); nb = ilaenv_(&c__1, (char *)"DSYTRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
lwkopt = *n * nb; i__1 = 1, i__2 = *n * nb;
lwkopt = max(i__1, i__2);
work[1] = (doublereal)lwkopt; work[1] = (doublereal)lwkopt;
} }
if (*info != 0) { if (*info != 0) {

24
lib/linalg/dsytrs.cpp
View File

@ -103,8 +103,8 @@ int dsytrs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda,
} }
if (ipiv[k] > 0) { if (ipiv[k] > 0) {
i__1 = k - 1; i__1 = k - 1;
dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[b_offset], ldb, &a[k * a_dim1 + 1], &c__1, dgemv_((char *)"T", &i__1, nrhs, &c_b7, &b[b_offset], ldb, &a[k * a_dim1 + 1], &c__1, &c_b19,
&c_b19, &b[k + b_dim1], ldb, (ftnlen)9); &b[k + b_dim1], ldb, (ftnlen)1);
kp = ipiv[k]; kp = ipiv[k];
if (kp != k) { if (kp != k) {
dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb); dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
@ -112,11 +112,11 @@ int dsytrs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda,
++k; ++k;
} else { } else {
i__1 = k - 1; i__1 = k - 1;
dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[b_offset], ldb, &a[k * a_dim1 + 1], &c__1, dgemv_((char *)"T", &i__1, nrhs, &c_b7, &b[b_offset], ldb, &a[k * a_dim1 + 1], &c__1, &c_b19,
&c_b19, &b[k + b_dim1], ldb, (ftnlen)9); &b[k + b_dim1], ldb, (ftnlen)1);
i__1 = k - 1; i__1 = k - 1;
dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[b_offset], ldb, &a[(k + 1) * a_dim1 + 1], dgemv_((char *)"T", &i__1, nrhs, &c_b7, &b[b_offset], ldb, &a[(k + 1) * a_dim1 + 1], &c__1,
&c__1, &c_b19, &b[k + 1 + b_dim1], ldb, (ftnlen)9); &c_b19, &b[k + 1 + b_dim1], ldb, (ftnlen)1);
kp = -ipiv[k]; kp = -ipiv[k];
if (kp != k) { if (kp != k) {
dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb); dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
@ -180,8 +180,8 @@ int dsytrs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda,
if (ipiv[k] > 0) { if (ipiv[k] > 0) {
if (k < *n) { if (k < *n) {
i__1 = *n - k; i__1 = *n - k;
dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[k + 1 + b_dim1], ldb, dgemv_((char *)"T", &i__1, nrhs, &c_b7, &b[k + 1 + b_dim1], ldb, &a[k + 1 + k * a_dim1],
&a[k + 1 + k * a_dim1], &c__1, &c_b19, &b[k + b_dim1], ldb, (ftnlen)9); &c__1, &c_b19, &b[k + b_dim1], ldb, (ftnlen)1);
} }
kp = ipiv[k]; kp = ipiv[k];
if (kp != k) { if (kp != k) {
@ -191,12 +191,12 @@ int dsytrs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda,
} else { } else {
if (k < *n) { if (k < *n) {
i__1 = *n - k; i__1 = *n - k;
dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[k + 1 + b_dim1], ldb, dgemv_((char *)"T", &i__1, nrhs, &c_b7, &b[k + 1 + b_dim1], ldb, &a[k + 1 + k * a_dim1],
&a[k + 1 + k * a_dim1], &c__1, &c_b19, &b[k + b_dim1], ldb, (ftnlen)9); &c__1, &c_b19, &b[k + b_dim1], ldb, (ftnlen)1);
i__1 = *n - k; i__1 = *n - k;
dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[k + 1 + b_dim1], ldb, dgemv_((char *)"T", &i__1, nrhs, &c_b7, &b[k + 1 + b_dim1], ldb,
&a[k + 1 + (k - 1) * a_dim1], &c__1, &c_b19, &b[k - 1 + b_dim1], ldb, &a[k + 1 + (k - 1) * a_dim1], &c__1, &c_b19, &b[k - 1 + b_dim1], ldb,
(ftnlen)9); (ftnlen)1);
} }
kp = -ipiv[k]; kp = -ipiv[k];
if (kp != k) { if (kp != k) {

7
lib/linalg/dtrevc3.cpp
View File

@ -51,8 +51,7 @@ int dtrevc3_(char *side, char *howmny, logical *select, integer *n, doublereal *
extern int dlaln2_(logical *, integer *, integer *, doublereal *, doublereal *, doublereal *, extern int dlaln2_(logical *, integer *, integer *, doublereal *, doublereal *, doublereal *,
integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *,
doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *,
integer *), integer *);
dlabad_(doublereal *, doublereal *);
extern doublereal dlamch_(char *, ftnlen); extern doublereal dlamch_(char *, ftnlen);
extern integer idamax_(integer *, doublereal *, integer *); extern integer idamax_(integer *, doublereal *, integer *);
extern int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, extern int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *,
@ -89,7 +88,8 @@ int dtrevc3_(char *side, char *howmny, logical *select, integer *n, doublereal *
i__1[1] = 1, a__1[1] = howmny; i__1[1] = 1, a__1[1] = howmny;
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2); s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
nb = ilaenv_(&c__1, (char *)"DTREVC", ch__1, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)2); nb = ilaenv_(&c__1, (char *)"DTREVC", ch__1, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)2);
maxwrk = *n + (*n << 1) * nb; i__2 = 1, i__3 = *n + (*n << 1) * nb;
maxwrk = max(i__2, i__3);
work[1] = (doublereal)maxwrk; work[1] = (doublereal)maxwrk;
lquery = *lwork == -1; lquery = *lwork == -1;
if (!rightv && !leftv) { if (!rightv && !leftv) {
@ -165,7 +165,6 @@ int dtrevc3_(char *side, char *howmny, logical *select, integer *n, doublereal *
} }
unfl = dlamch_((char *)"Safe minimum", (ftnlen)12); unfl = dlamch_((char *)"Safe minimum", (ftnlen)12);
ovfl = 1. / unfl; ovfl = 1. / unfl;
dlabad_(&unfl, &ovfl);
ulp = dlamch_((char *)"Precision", (ftnlen)9); ulp = dlamch_((char *)"Precision", (ftnlen)9);
smlnum = unfl * (*n / ulp); smlnum = unfl * (*n / ulp);
bignum = (1. - ulp) / smlnum; bignum = (1. - ulp) / smlnum;

8
lib/linalg/dtrti2.cpp
View File

@ -46,8 +46,8 @@ int dtrti2_(char *uplo, char *diag, integer *n, doublereal *a, integer *lda, int
ajj = -1.; ajj = -1.;
} }
i__2 = j - 1; i__2 = j - 1;
dtrmv_((char *)"Upper", (char *)"No transpose", diag, &i__2, &a[a_offset], lda, &a[j * a_dim1 + 1], dtrmv_((char *)"U", (char *)"N", diag, &i__2, &a[a_offset], lda, &a[j * a_dim1 + 1], &c__1, (ftnlen)1,
&c__1, (ftnlen)5, (ftnlen)12, (ftnlen)1); (ftnlen)1, (ftnlen)1);
i__2 = j - 1; i__2 = j - 1;
dscal_(&i__2, &ajj, &a[j * a_dim1 + 1], &c__1); dscal_(&i__2, &ajj, &a[j * a_dim1 + 1], &c__1);
} }
@ -61,8 +61,8 @@ int dtrti2_(char *uplo, char *diag, integer *n, doublereal *a, integer *lda, int
} }
if (j < *n) { if (j < *n) {
i__1 = *n - j; i__1 = *n - j;
dtrmv_((char *)"Lower", (char *)"No transpose", diag, &i__1, &a[j + 1 + (j + 1) * a_dim1], lda, dtrmv_((char *)"L", (char *)"N", diag, &i__1, &a[j + 1 + (j + 1) * a_dim1], lda,
&a[j + 1 + j * a_dim1], &c__1, (ftnlen)5, (ftnlen)12, (ftnlen)1); &a[j + 1 + j * a_dim1], &c__1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__1 = *n - j; i__1 = *n - j;
dscal_(&i__1, &ajj, &a[j + 1 + j * a_dim1], &c__1); dscal_(&i__1, &ajj, &a[j + 1 + j * a_dim1], &c__1);
} }

25
lib/linalg/dtrtri.cpp
View File

@ -74,13 +74,12 @@ int dtrtri_(char *uplo, char *diag, integer *n, doublereal *a, integer *lda, int
i__4 = nb, i__5 = *n - j + 1; i__4 = nb, i__5 = *n - j + 1;
jb = min(i__4, i__5); jb = min(i__4, i__5);
i__4 = j - 1; i__4 = j - 1;
dtrmm_((char *)"Left", (char *)"Upper", (char *)"No transpose", diag, &i__4, &jb, &c_b18, &a[a_offset], lda, dtrmm_((char *)"L", (char *)"U", (char *)"N", diag, &i__4, &jb, &c_b18, &a[a_offset], lda,
&a[j * a_dim1 + 1], lda, (ftnlen)4, (ftnlen)5, (ftnlen)12, (ftnlen)1); &a[j * a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__4 = j - 1; i__4 = j - 1;
dtrsm_((char *)"Right", (char *)"Upper", (char *)"No transpose", diag, &i__4, &jb, &c_b22, dtrsm_((char *)"R", (char *)"U", (char *)"N", diag, &i__4, &jb, &c_b22, &a[j + j * a_dim1], lda,
&a[j + j * a_dim1], lda, &a[j * a_dim1 + 1], lda, (ftnlen)5, (ftnlen)5, &a[j * a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)12, (ftnlen)1); dtrti2_((char *)"U", diag, &jb, &a[j + j * a_dim1], lda, info, (ftnlen)1, (ftnlen)1);
dtrti2_((char *)"Upper", diag, &jb, &a[j + j * a_dim1], lda, info, (ftnlen)5, (ftnlen)1);
} }
} else { } else {
nn = (*n - 1) / nb * nb + 1; nn = (*n - 1) / nb * nb + 1;
@ -90,15 +89,15 @@ int dtrtri_(char *uplo, char *diag, integer *n, doublereal *a, integer *lda, int
jb = min(i__1, i__4); jb = min(i__1, i__4);
if (j + jb <= *n) { if (j + jb <= *n) {
i__1 = *n - j - jb + 1; i__1 = *n - j - jb + 1;
dtrmm_((char *)"Left", (char *)"Lower", (char *)"No transpose", diag, &i__1, &jb, &c_b18, dtrmm_((char *)"L", (char *)"L", (char *)"N", diag, &i__1, &jb, &c_b18, &a[j + jb + (j + jb) * a_dim1],
&a[j + jb + (j + jb) * a_dim1], lda, &a[j + jb + j * a_dim1], lda, lda, &a[j + jb + j * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)4, (ftnlen)5, (ftnlen)12, (ftnlen)1); (ftnlen)1);
i__1 = *n - j - jb + 1; i__1 = *n - j - jb + 1;
dtrsm_((char *)"Right", (char *)"Lower", (char *)"No transpose", diag, &i__1, &jb, &c_b22, dtrsm_((char *)"R", (char *)"L", (char *)"N", diag, &i__1, &jb, &c_b22, &a[j + j * a_dim1], lda,
&a[j + j * a_dim1], lda, &a[j + jb + j * a_dim1], lda, (ftnlen)5, &a[j + jb + j * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)5, (ftnlen)12, (ftnlen)1); (ftnlen)1);
} }
dtrti2_((char *)"Lower", diag, &jb, &a[j + j * a_dim1], lda, info, (ftnlen)5, (ftnlen)1); dtrti2_((char *)"L", diag, &jb, &a[j + j * a_dim1], lda, info, (ftnlen)1, (ftnlen)1);
} }
} }
} }

4
lib/linalg/dtrtrs.cpp
View File

@ -56,8 +56,8 @@ int dtrtrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub
} }
} }
*info = 0; *info = 0;
dtrsm_((char *)"Left", uplo, trans, diag, n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb, dtrsm_((char *)"L", uplo, trans, diag, n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
(ftnlen)4, (ftnlen)1, (ftnlen)1, (ftnlen)1); (ftnlen)1, (ftnlen)1, (ftnlen)1);
return 0; return 0;
} }
#ifdef __cplusplus #ifdef __cplusplus

11
lib/linalg/zgetrf.cpp
View File

@ -69,16 +69,15 @@ int zgetrf_(integer *m, integer *n, doublecomplex *a, integer *lda, integer *ipi
i__4 = j + jb - 1; i__4 = j + jb - 1;
zlaswp_(&i__3, &a[(j + jb) * a_dim1 + 1], lda, &j, &i__4, &ipiv[1], &c__1); zlaswp_(&i__3, &a[(j + jb) * a_dim1 + 1], lda, &j, &i__4, &ipiv[1], &c__1);
i__3 = *n - j - jb + 1; i__3 = *n - j - jb + 1;
ztrsm_((char *)"Left", (char *)"Lower", (char *)"No transpose", (char *)"Unit", &jb, &i__3, &c_b1, ztrsm_((char *)"L", (char *)"L", (char *)"N", (char *)"U", &jb, &i__3, &c_b1, &a[j + j * a_dim1], lda,
&a[j + j * a_dim1], lda, &a[j + (j + jb) * a_dim1], lda, (ftnlen)4, &a[j + (j + jb) * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12, (ftnlen)4);
if (j + jb <= *m) { if (j + jb <= *m) {
i__3 = *m - j - jb + 1; i__3 = *m - j - jb + 1;
i__4 = *n - j - jb + 1; i__4 = *n - j - jb + 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"No transpose", &i__3, &i__4, &jb, &z__1, zgemm_((char *)"N", (char *)"N", &i__3, &i__4, &jb, &z__1, &a[j + jb + j * a_dim1], lda,
&a[j + jb + j * a_dim1], lda, &a[j + (j + jb) * a_dim1], lda, &c_b1, &a[j + (j + jb) * a_dim1], lda, &c_b1, &a[j + jb + (j + jb) * a_dim1],
&a[j + jb + (j + jb) * a_dim1], lda, (ftnlen)12, (ftnlen)12); lda, (ftnlen)1, (ftnlen)1);
} }
} }
} }

19
lib/linalg/zgetri.cpp
View File

@ -35,7 +35,8 @@ int zgetri_(integer *n, doublecomplex *a, integer *lda, integer *ipiv, doublecom
--work; --work;
*info = 0; *info = 0;
nb = ilaenv_(&c__1, (char *)"ZGETRI", (char *)" ", n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); nb = ilaenv_(&c__1, (char *)"ZGETRI", (char *)" ", n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
lwkopt = *n * nb; i__1 = 1, i__2 = *n * nb;
lwkopt = max(i__1, i__2);
work[1].r = (doublereal)lwkopt, work[1].i = 0.; work[1].r = (doublereal)lwkopt, work[1].i = 0.;
lquery = *lwork == -1; lquery = *lwork == -1;
if (*n < 0) { if (*n < 0) {
@ -55,7 +56,7 @@ int zgetri_(integer *n, doublecomplex *a, integer *lda, integer *ipiv, doublecom
if (*n == 0) { if (*n == 0) {
return 0; return 0;
} }
ztrtri_((char *)"Upper", (char *)"Non-unit", n, &a[a_offset], lda, info, (ftnlen)5, (ftnlen)8); ztrtri_((char *)"U", (char *)"N", n, &a[a_offset], lda, info, (ftnlen)1, (ftnlen)1);
if (*info > 0) { if (*info > 0) {
return 0; return 0;
} }
@ -86,8 +87,8 @@ int zgetri_(integer *n, doublecomplex *a, integer *lda, integer *ipiv, doublecom
if (j < *n) { if (j < *n) {
i__1 = *n - j; i__1 = *n - j;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", n, &i__1, &z__1, &a[(j + 1) * a_dim1 + 1], lda, &work[j + 1], zgemv_((char *)"N", n, &i__1, &z__1, &a[(j + 1) * a_dim1 + 1], lda, &work[j + 1], &c__1,
&c__1, &c_b2, &a[j * a_dim1 + 1], &c__1, (ftnlen)12); &c_b2, &a[j * a_dim1 + 1], &c__1, (ftnlen)1);
} }
} }
} else { } else {
@ -110,12 +111,12 @@ int zgetri_(integer *n, doublecomplex *a, integer *lda, integer *ipiv, doublecom
if (j + jb <= *n) { if (j + jb <= *n) {
i__2 = *n - j - jb + 1; i__2 = *n - j - jb + 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"No transpose", n, &jb, &i__2, &z__1, zgemm_((char *)"N", (char *)"N", n, &jb, &i__2, &z__1, &a[(j + jb) * a_dim1 + 1], lda,
&a[(j + jb) * a_dim1 + 1], lda, &work[j + jb], &ldwork, &c_b2, &work[j + jb], &ldwork, &c_b2, &a[j * a_dim1 + 1], lda, (ftnlen)1,
&a[j * a_dim1 + 1], lda, (ftnlen)12, (ftnlen)12); (ftnlen)1);
} }
ztrsm_((char *)"Right", (char *)"Lower", (char *)"No transpose", (char *)"Unit", n, &jb, &c_b2, &work[j], &ldwork, ztrsm_((char *)"R", (char *)"L", (char *)"N", (char *)"U", n, &jb, &c_b2, &work[j], &ldwork, &a[j * a_dim1 + 1], lda,
&a[j * a_dim1 + 1], lda, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
} }
for (j = *n - 1; j >= 1; --j) { for (j = *n - 1; j >= 1; --j) {

4
lib/linalg/zheevd.cpp
View File

@ -100,7 +100,7 @@ int zheevd_(char *jobz, char *uplo, integer *n, doublecomplex *a, integer *lda,
liopt = liwmin; liopt = liwmin;
} }
work[1].r = (doublereal)lopt, work[1].i = 0.; work[1].r = (doublereal)lopt, work[1].i = 0.;
rwork[1] = (doublereal)lropt; rwork[1] = (real)lropt;
iwork[1] = liopt; iwork[1] = liopt;
if (*lwork < lwmin && !lquery) { if (*lwork < lwmin && !lquery) {
*info = -8; *info = -8;
@ -176,7 +176,7 @@ int zheevd_(char *jobz, char *uplo, integer *n, doublecomplex *a, integer *lda,
dscal_(&imax, &d__1, &w[1], &c__1); dscal_(&imax, &d__1, &w[1], &c__1);
} }
work[1].r = (doublereal)lopt, work[1].i = 0.; work[1].r = (doublereal)lopt, work[1].i = 0.;
rwork[1] = (doublereal)lropt; rwork[1] = (real)lropt;
iwork[1] = liopt; iwork[1] = liopt;
return 0; return 0;
} }

17
lib/linalg/zhegs2.cpp
View File

@ -86,9 +86,8 @@ int zhegs2_(integer *itype, char *uplo, integer *n, doublecomplex *a, integer *l
i__2 = *n - k; i__2 = *n - k;
zlacgv_(&i__2, &b[k + (k + 1) * b_dim1], ldb); zlacgv_(&i__2, &b[k + (k + 1) * b_dim1], ldb);
i__2 = *n - k; i__2 = *n - k;
ztrsv_(uplo, (char *)"Conjugate transpose", (char *)"Non-unit", &i__2, ztrsv_(uplo, (char *)"C", (char *)"N", &i__2, &b[k + 1 + (k + 1) * b_dim1], ldb,
&b[k + 1 + (k + 1) * b_dim1], ldb, &a[k + (k + 1) * a_dim1], lda, &a[k + (k + 1) * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)1, (ftnlen)19, (ftnlen)8);
i__2 = *n - k; i__2 = *n - k;
zlacgv_(&i__2, &a[k + (k + 1) * a_dim1], lda); zlacgv_(&i__2, &a[k + (k + 1) * a_dim1], lda);
} }
@ -122,8 +121,8 @@ int zhegs2_(integer *itype, char *uplo, integer *n, doublecomplex *a, integer *l
zaxpy_(&i__2, &ct, &b[k + 1 + k * b_dim1], &c__1, &a[k + 1 + k * a_dim1], zaxpy_(&i__2, &ct, &b[k + 1 + k * b_dim1], &c__1, &a[k + 1 + k * a_dim1],
&c__1); &c__1);
i__2 = *n - k; i__2 = *n - k;
ztrsv_(uplo, (char *)"No transpose", (char *)"Non-unit", &i__2, &b[k + 1 + (k + 1) * b_dim1], ztrsv_(uplo, (char *)"N", (char *)"N", &i__2, &b[k + 1 + (k + 1) * b_dim1], ldb,
ldb, &a[k + 1 + k * a_dim1], &c__1, (ftnlen)1, (ftnlen)12, (ftnlen)8); &a[k + 1 + k * a_dim1], &c__1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
} }
} }
@ -136,8 +135,8 @@ int zhegs2_(integer *itype, char *uplo, integer *n, doublecomplex *a, integer *l
i__2 = k + k * b_dim1; i__2 = k + k * b_dim1;
bkk = b[i__2].r; bkk = b[i__2].r;
i__2 = k - 1; i__2 = k - 1;
ztrmv_(uplo, (char *)"No transpose", (char *)"Non-unit", &i__2, &b[b_offset], ldb, ztrmv_(uplo, (char *)"N", (char *)"N", &i__2, &b[b_offset], ldb, &a[k * a_dim1 + 1], &c__1,
&a[k * a_dim1 + 1], &c__1, (ftnlen)1, (ftnlen)12, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1);
d__1 = akk * .5; d__1 = akk * .5;
ct.r = d__1, ct.i = 0.; ct.r = d__1, ct.i = 0.;
i__2 = k - 1; i__2 = k - 1;
@ -164,8 +163,8 @@ int zhegs2_(integer *itype, char *uplo, integer *n, doublecomplex *a, integer *l
i__2 = k - 1; i__2 = k - 1;
zlacgv_(&i__2, &a[k + a_dim1], lda); zlacgv_(&i__2, &a[k + a_dim1], lda);
i__2 = k - 1; i__2 = k - 1;
ztrmv_(uplo, (char *)"Conjugate transpose", (char *)"Non-unit", &i__2, &b[b_offset], ldb, ztrmv_(uplo, (char *)"C", (char *)"N", &i__2, &b[b_offset], ldb, &a[k + a_dim1], lda, (ftnlen)1,
&a[k + a_dim1], lda, (ftnlen)1, (ftnlen)19, (ftnlen)8); (ftnlen)1, (ftnlen)1);
d__1 = akk * .5; d__1 = akk * .5;
ct.r = d__1, ct.i = 0.; ct.r = d__1, ct.i = 0.;
i__2 = k - 1; i__2 = k - 1;

8
lib/linalg/zhegv.cpp
View File

@ -95,16 +95,16 @@ int zhegv_(integer *itype, char *jobz, char *uplo, integer *n, doublecomplex *a,
} else { } else {
*(unsigned char *)trans = 'C'; *(unsigned char *)trans = 'C';
} }
ztrsm_((char *)"Left", uplo, trans, (char *)"Non-unit", n, &neig, &c_b1, &b[b_offset], ldb, ztrsm_((char *)"L", uplo, trans, (char *)"N", n, &neig, &c_b1, &b[b_offset], ldb, &a[a_offset], lda,
&a[a_offset], lda, (ftnlen)4, (ftnlen)1, (ftnlen)1, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} else if (*itype == 3) { } else if (*itype == 3) {
if (upper) { if (upper) {
*(unsigned char *)trans = 'C'; *(unsigned char *)trans = 'C';
} else { } else {
*(unsigned char *)trans = 'N'; *(unsigned char *)trans = 'N';
} }
ztrmm_((char *)"Left", uplo, trans, (char *)"Non-unit", n, &neig, &c_b1, &b[b_offset], ldb, ztrmm_((char *)"L", uplo, trans, (char *)"N", n, &neig, &c_b1, &b[b_offset], ldb, &a[a_offset], lda,
&a[a_offset], lda, (ftnlen)4, (ftnlen)1, (ftnlen)1, (ftnlen)8); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
} }
work[1].r = (doublereal)lwkopt, work[1].i = 0.; work[1].r = (doublereal)lwkopt, work[1].i = 0.;

18
lib/linalg/zherk.cpp
View File

@ -249,12 +249,11 @@ int zherk_(char *uplo, char *trans, integer *n, integer *k, doublereal *alpha, d
rtemp = 0.; rtemp = 0.;
i__2 = *k; i__2 = *k;
for (l = 1; l <= i__2; ++l) { for (l = 1; l <= i__2; ++l) {
d_lmp_cnjg(&z__3, &a[l + j * a_dim1]); d_lmp_cnjg(&z__2, &a[l + j * a_dim1]);
i__3 = l + j * a_dim1; i__3 = l + j * a_dim1;
z__2.r = z__3.r * a[i__3].r - z__3.i * a[i__3].i, z__1.r = z__2.r * a[i__3].r - z__2.i * a[i__3].i,
z__2.i = z__3.r * a[i__3].i + z__3.i * a[i__3].r; z__1.i = z__2.r * a[i__3].i + z__2.i * a[i__3].r;
z__1.r = rtemp + z__2.r, z__1.i = z__2.i; rtemp += z__1.r;
rtemp = z__1.r;
} }
if (*beta == 0.) { if (*beta == 0.) {
i__2 = j + j * c_dim1; i__2 = j + j * c_dim1;
@ -273,12 +272,11 @@ int zherk_(char *uplo, char *trans, integer *n, integer *k, doublereal *alpha, d
rtemp = 0.; rtemp = 0.;
i__2 = *k; i__2 = *k;
for (l = 1; l <= i__2; ++l) { for (l = 1; l <= i__2; ++l) {
d_lmp_cnjg(&z__3, &a[l + j * a_dim1]); d_lmp_cnjg(&z__2, &a[l + j * a_dim1]);
i__3 = l + j * a_dim1; i__3 = l + j * a_dim1;
z__2.r = z__3.r * a[i__3].r - z__3.i * a[i__3].i, z__1.r = z__2.r * a[i__3].r - z__2.i * a[i__3].i,
z__2.i = z__3.r * a[i__3].i + z__3.i * a[i__3].r; z__1.i = z__2.r * a[i__3].i + z__2.i * a[i__3].r;
z__1.r = rtemp + z__2.r, z__1.i = z__2.i; rtemp += z__1.r;
rtemp = z__1.r;
} }
if (*beta == 0.) { if (*beta == 0.) {
i__2 = j + j * c_dim1; i__2 = j + j * c_dim1;

12
lib/linalg/zhetrd.cpp
View File

@ -49,7 +49,8 @@ int zhetrd_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal *
} }
if (*info == 0) { if (*info == 0) {
nb = ilaenv_(&c__1, (char *)"ZHETRD", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); nb = ilaenv_(&c__1, (char *)"ZHETRD", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
lwkopt = *n * nb; i__1 = 1, i__2 = *n * nb;
lwkopt = max(i__1, i__2);
work[1].r = (doublereal)lwkopt, work[1].i = 0.; work[1].r = (doublereal)lwkopt, work[1].i = 0.;
} }
if (*info != 0) { if (*info != 0) {
@ -97,8 +98,8 @@ int zhetrd_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal *
(ftnlen)1); (ftnlen)1);
i__3 = i__ - 1; i__3 = i__ - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zher2k_(uplo, (char *)"No transpose", &i__3, &nb, &z__1, &a[i__ * a_dim1 + 1], lda, &work[1], zher2k_(uplo, (char *)"N", &i__3, &nb, &z__1, &a[i__ * a_dim1 + 1], lda, &work[1], &ldwork,
&ldwork, &c_b23, &a[a_offset], lda, (ftnlen)1, (ftnlen)12); &c_b23, &a[a_offset], lda, (ftnlen)1, (ftnlen)1);
i__3 = i__ + nb - 1; i__3 = i__ + nb - 1;
for (j = i__; j <= i__3; ++j) { for (j = i__; j <= i__3; ++j) {
i__4 = j - 1 + j * a_dim1; i__4 = j - 1 + j * a_dim1;
@ -118,9 +119,8 @@ int zhetrd_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal *
&ldwork, (ftnlen)1); &ldwork, (ftnlen)1);
i__3 = *n - i__ - nb + 1; i__3 = *n - i__ - nb + 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zher2k_(uplo, (char *)"No transpose", &i__3, &nb, &z__1, &a[i__ + nb + i__ * a_dim1], lda, zher2k_(uplo, (char *)"N", &i__3, &nb, &z__1, &a[i__ + nb + i__ * a_dim1], lda, &work[nb + 1],
&work[nb + 1], &ldwork, &c_b23, &a[i__ + nb + (i__ + nb) * a_dim1], lda, &ldwork, &c_b23, &a[i__ + nb + (i__ + nb) * a_dim1], lda, (ftnlen)1, (ftnlen)1);
(ftnlen)1, (ftnlen)12);
i__3 = i__ + nb - 1; i__3 = i__ + nb - 1;
for (j = i__; j <= i__3; ++j) { for (j = i__; j <= i__3; ++j) {
i__4 = j + 1 + j * a_dim1; i__4 = j + 1 + j * a_dim1;

3
lib/linalg/zhetrf.cpp
View File

@ -40,7 +40,8 @@ int zhetrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi
} }
if (*info == 0) { if (*info == 0) {
nb = ilaenv_(&c__1, (char *)"ZHETRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); nb = ilaenv_(&c__1, (char *)"ZHETRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
lwkopt = *n * nb; i__1 = 1, i__2 = *n * nb;
lwkopt = max(i__1, i__2);
work[1].r = (doublereal)lwkopt, work[1].i = 0.; work[1].r = (doublereal)lwkopt, work[1].i = 0.;
} }
if (*info != 0) { if (*info != 0) {

90
lib/linalg/zlahef.cpp
View File

@ -7,7 +7,7 @@ static integer c__1 = 1;
int zlahef_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a, integer *lda, int zlahef_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a, integer *lda,
integer *ipiv, doublecomplex *w, integer *ldw, integer *info, ftnlen uplo_len) integer *ipiv, doublecomplex *w, integer *ldw, integer *info, ftnlen uplo_len)
{ {
integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4, i__5; integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
doublereal d__1, d__2, d__3, d__4; doublereal d__1, d__2, d__3, d__4;
doublecomplex z__1, z__2, z__3, z__4; doublecomplex z__1, z__2, z__3, z__4;
double sqrt(doublereal), d_lmp_imag(doublecomplex *); double sqrt(doublereal), d_lmp_imag(doublecomplex *);
@ -16,12 +16,9 @@ int zlahef_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
integer j, k; integer j, k;
doublereal t, r1; doublereal t, r1;
doublecomplex d11, d21, d22; doublecomplex d11, d21, d22;
integer jb, jj, kk, jp, kp, kw, kkw, imax, jmax; integer jj, kk, jp, kp, kw, kkw, imax, jmax;
doublereal alpha; doublereal alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *,
doublecomplex *, integer *, ftnlen, ftnlen);
integer kstep; integer kstep;
extern int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, extern int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *,
@ -34,6 +31,9 @@ int zlahef_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
extern int zlacgv_(integer *, doublecomplex *, integer *); extern int zlacgv_(integer *, doublecomplex *, integer *);
extern integer izamax_(integer *, doublecomplex *, integer *); extern integer izamax_(integer *, doublecomplex *, integer *);
doublereal rowmax; doublereal rowmax;
extern int zgemmtr_(char *, char *, char *, integer *, integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *,
doublecomplex *, integer *, ftnlen, ftnlen, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -60,8 +60,8 @@ int zlahef_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
if (k < *n) { if (k < *n) {
i__1 = *n - k; i__1 = *n - k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda, zgemv_((char *)"N", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda, &w[k + (kw + 1) * w_dim1],
&w[k + (kw + 1) * w_dim1], ldw, &c_b1, &w[kw * w_dim1 + 1], &c__1, (ftnlen)12); ldw, &c_b1, &w[kw * w_dim1 + 1], &c__1, (ftnlen)1);
i__1 = k + kw * w_dim1; i__1 = k + kw * w_dim1;
i__2 = k + kw * w_dim1; i__2 = k + kw * w_dim1;
d__1 = w[i__2].r; d__1 = w[i__2].r;
@ -105,9 +105,9 @@ int zlahef_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
if (k < *n) { if (k < *n) {
i__1 = *n - k; i__1 = *n - k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda, zgemv_((char *)"N", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda,
&w[imax + (kw + 1) * w_dim1], ldw, &c_b1, &w[(kw - 1) * w_dim1 + 1], &w[imax + (kw + 1) * w_dim1], ldw, &c_b1, &w[(kw - 1) * w_dim1 + 1],
&c__1, (ftnlen)12); &c__1, (ftnlen)1);
i__1 = imax + (kw - 1) * w_dim1; i__1 = imax + (kw - 1) * w_dim1;
i__2 = imax + (kw - 1) * w_dim1; i__2 = imax + (kw - 1) * w_dim1;
d__1 = w[i__2].r; d__1 = w[i__2].r;
@ -232,34 +232,11 @@ int zlahef_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
k -= kstep; k -= kstep;
goto L10; goto L10;
L30: L30:
i__1 = -(*nb); i__1 = *n - k;
for (j = (k - 1) / *nb * *nb + 1; i__1 < 0 ? j >= 1 : j <= 1; j += i__1) {
i__2 = *nb, i__3 = k - j + 1;
jb = min(i__2, i__3);
i__2 = j + jb - 1;
for (jj = j; jj <= i__2; ++jj) {
i__3 = jj + jj * a_dim1;
i__4 = jj + jj * a_dim1;
d__1 = a[i__4].r;
a[i__3].r = d__1, a[i__3].i = 0.;
i__3 = jj - j + 1;
i__4 = *n - k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__3, &i__4, &z__1, &a[j + (k + 1) * a_dim1], lda, zgemmtr_((char *)"U", (char *)"N", (char *)"T", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda,
&w[jj + (kw + 1) * w_dim1], ldw, &c_b1, &a[j + jj * a_dim1], &c__1, &w[(kw + 1) * w_dim1 + 1], ldw, &c_b1, &a[a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1,
(ftnlen)12); (ftnlen)1);
i__3 = jj + jj * a_dim1;
i__4 = jj + jj * a_dim1;
d__1 = a[i__4].r;
a[i__3].r = d__1, a[i__3].i = 0.;
}
i__2 = j - 1;
i__3 = *n - k;
z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"Transpose", &i__2, &jb, &i__3, &z__1, &a[(k + 1) * a_dim1 + 1],
lda, &w[j + (kw + 1) * w_dim1], ldw, &c_b1, &a[j * a_dim1 + 1], lda, (ftnlen)12,
(ftnlen)9);
}
j = k + 1; j = k + 1;
L60: L60:
jj = j; jj = j;
@ -295,8 +272,8 @@ int zlahef_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
i__1 = *n - k + 1; i__1 = *n - k + 1;
i__2 = k - 1; i__2 = k - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[k + w_dim1], ldw, &c_b1, zgemv_((char *)"N", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[k + w_dim1], ldw, &c_b1,
&w[k + k * w_dim1], &c__1, (ftnlen)12); &w[k + k * w_dim1], &c__1, (ftnlen)1);
i__1 = k + k * w_dim1; i__1 = k + k * w_dim1;
i__2 = k + k * w_dim1; i__2 = k + k * w_dim1;
d__1 = w[i__2].r; d__1 = w[i__2].r;
@ -341,8 +318,8 @@ int zlahef_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
i__1 = *n - k + 1; i__1 = *n - k + 1;
i__2 = k - 1; i__2 = k - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[imax + w_dim1], zgemv_((char *)"N", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[imax + w_dim1], ldw, &c_b1,
ldw, &c_b1, &w[k + (k + 1) * w_dim1], &c__1, (ftnlen)12); &w[k + (k + 1) * w_dim1], &c__1, (ftnlen)1);
i__1 = imax + (k + 1) * w_dim1; i__1 = imax + (k + 1) * w_dim1;
i__2 = imax + (k + 1) * w_dim1; i__2 = imax + (k + 1) * w_dim1;
d__1 = w[i__2].r; d__1 = w[i__2].r;
@ -466,36 +443,11 @@ int zlahef_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
k += kstep; k += kstep;
goto L70; goto L70;
L90: L90:
i__1 = *n; i__1 = *n - k + 1;
i__2 = *nb; i__2 = k - 1;
for (j = k; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
i__3 = *nb, i__4 = *n - j + 1;
jb = min(i__3, i__4);
i__3 = j + jb - 1;
for (jj = j; jj <= i__3; ++jj) {
i__4 = jj + jj * a_dim1;
i__5 = jj + jj * a_dim1;
d__1 = a[i__5].r;
a[i__4].r = d__1, a[i__4].i = 0.;
i__4 = j + jb - jj;
i__5 = k - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__4, &i__5, &z__1, &a[jj + a_dim1], lda, &w[jj + w_dim1], zgemmtr_((char *)"L", (char *)"N", (char *)"T", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[k + w_dim1], ldw,
ldw, &c_b1, &a[jj + jj * a_dim1], &c__1, (ftnlen)12); &c_b1, &a[k + k * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__4 = jj + jj * a_dim1;
i__5 = jj + jj * a_dim1;
d__1 = a[i__5].r;
a[i__4].r = d__1, a[i__4].i = 0.;
}
if (j + jb <= *n) {
i__3 = *n - j - jb + 1;
i__4 = k - 1;
z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"Transpose", &i__3, &jb, &i__4, &z__1, &a[j + jb + a_dim1],
lda, &w[j + w_dim1], ldw, &c_b1, &a[j + jb + j * a_dim1], lda, (ftnlen)12,
(ftnlen)9);
}
}
j = k - 1; j = k - 1;
L120: L120:
jj = j; jj = j;

8
lib/linalg/zlarf.cpp
View File

@ -54,15 +54,15 @@ int zlarf_(char *side, integer *m, integer *n, doublecomplex *v, integer *incv,
} }
if (applyleft) { if (applyleft) {
if (lastv > 0) { if (lastv > 0) {
zgemv_((char *)"Conjugate transpose", &lastv, &lastc, &c_b1, &c__[c_offset], ldc, &v[1], incv, zgemv_((char *)"C", &lastv, &lastc, &c_b1, &c__[c_offset], ldc, &v[1], incv, &c_b2, &work[1],
&c_b2, &work[1], &c__1, (ftnlen)19); &c__1, (ftnlen)1);
z__1.r = -tau->r, z__1.i = -tau->i; z__1.r = -tau->r, z__1.i = -tau->i;
zgerc_(&lastv, &lastc, &z__1, &v[1], incv, &work[1], &c__1, &c__[c_offset], ldc); zgerc_(&lastv, &lastc, &z__1, &v[1], incv, &work[1], &c__1, &c__[c_offset], ldc);
} }
} else { } else {
if (lastv > 0) { if (lastv > 0) {
zgemv_((char *)"No transpose", &lastc, &lastv, &c_b1, &c__[c_offset], ldc, &v[1], incv, &c_b2, zgemv_((char *)"N", &lastc, &lastv, &c_b1, &c__[c_offset], ldc, &v[1], incv, &c_b2, &work[1],
&work[1], &c__1, (ftnlen)12); &c__1, (ftnlen)1);
z__1.r = -tau->r, z__1.i = -tau->i; z__1.r = -tau->r, z__1.i = -tau->i;
zgerc_(&lastc, &lastv, &z__1, &work[1], &c__1, &v[1], incv, &c__[c_offset], ldc); zgerc_(&lastc, &lastv, &z__1, &work[1], &c__1, &v[1], incv, &c__[c_offset], ldc);
} }

196
lib/linalg/zlarfb.cpp
View File

@ -52,26 +52,25 @@ int zlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
zcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); zcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1);
zlacgv_(n, &work[j * work_dim1 + 1], &c__1); zlacgv_(n, &work[j * work_dim1 + 1], &c__1);
} }
ztrmm_((char *)"Right", (char *)"Lower", (char *)"No transpose", (char *)"Unit", n, k, &c_b1, &v[v_offset], ldv, ztrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"U", n, k, &c_b1, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
zgemm_((char *)"Conjugate transpose", (char *)"No transpose", n, k, &i__1, &c_b1, zgemm_((char *)"C", (char *)"N", n, k, &i__1, &c_b1, &c__[*k + 1 + c_dim1], ldc,
&c__[*k + 1 + c_dim1], ldc, &v[*k + 1 + v_dim1], ldv, &c_b1, &v[*k + 1 + v_dim1], ldv, &c_b1, &work[work_offset], ldwork, (ftnlen)1,
&work[work_offset], ldwork, (ftnlen)19, (ftnlen)12); (ftnlen)1);
} }
ztrmm_((char *)"Right", (char *)"Upper", transt, (char *)"Non-unit", n, k, &c_b1, &t[t_offset], ldt, ztrmm_((char *)"R", (char *)"U", transt, (char *)"N", n, k, &c_b1, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"Conjugate transpose", &i__1, n, k, &z__1, zgemm_((char *)"N", (char *)"C", &i__1, n, k, &z__1, &v[*k + 1 + v_dim1], ldv,
&v[*k + 1 + v_dim1], ldv, &work[work_offset], ldwork, &c_b1, &work[work_offset], ldwork, &c_b1, &c__[*k + 1 + c_dim1], ldc, (ftnlen)1,
&c__[*k + 1 + c_dim1], ldc, (ftnlen)12, (ftnlen)19); (ftnlen)1);
} }
ztrmm_((char *)"Right", (char *)"Lower", (char *)"Conjugate transpose", (char *)"Unit", n, k, &c_b1, &v[v_offset], ztrmm_((char *)"R", (char *)"L", (char *)"C", (char *)"U", n, k, &c_b1, &v[v_offset], ldv, &work[work_offset],
ldv, &work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)19, ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)4);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *n; i__2 = *n;
@ -88,26 +87,25 @@ int zlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
zcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], &c__1); zcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], &c__1);
} }
ztrmm_((char *)"Right", (char *)"Lower", (char *)"No transpose", (char *)"Unit", m, k, &c_b1, &v[v_offset], ldv, ztrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"U", m, k, &c_b1, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
zgemm_((char *)"No transpose", (char *)"No transpose", m, k, &i__1, &c_b1, zgemm_((char *)"N", (char *)"N", m, k, &i__1, &c_b1, &c__[(*k + 1) * c_dim1 + 1], ldc,
&c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k + 1 + v_dim1], ldv, &c_b1, &v[*k + 1 + v_dim1], ldv, &c_b1, &work[work_offset], ldwork, (ftnlen)1,
&work[work_offset], ldwork, (ftnlen)12, (ftnlen)12); (ftnlen)1);
} }
ztrmm_((char *)"Right", (char *)"Upper", trans, (char *)"Non-unit", m, k, &c_b1, &t[t_offset], ldt, ztrmm_((char *)"R", (char *)"U", trans, (char *)"N", m, k, &c_b1, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"Conjugate transpose", m, &i__1, k, &z__1, zgemm_((char *)"N", (char *)"C", m, &i__1, k, &z__1, &work[work_offset], ldwork,
&work[work_offset], ldwork, &v[*k + 1 + v_dim1], ldv, &c_b1, &v[*k + 1 + v_dim1], ldv, &c_b1, &c__[(*k + 1) * c_dim1 + 1], ldc,
&c__[(*k + 1) * c_dim1 + 1], ldc, (ftnlen)12, (ftnlen)19); (ftnlen)1, (ftnlen)1);
} }
ztrmm_((char *)"Right", (char *)"Lower", (char *)"Conjugate transpose", (char *)"Unit", m, k, &c_b1, &v[v_offset], ztrmm_((char *)"R", (char *)"L", (char *)"C", (char *)"U", m, k, &c_b1, &v[v_offset], ldv, &work[work_offset],
ldv, &work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)19, ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)4);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *m; i__2 = *m;
@ -127,27 +125,23 @@ int zlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
zcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); zcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1);
zlacgv_(n, &work[j * work_dim1 + 1], &c__1); zlacgv_(n, &work[j * work_dim1 + 1], &c__1);
} }
ztrmm_((char *)"Right", (char *)"Upper", (char *)"No transpose", (char *)"Unit", n, k, &c_b1, ztrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"U", n, k, &c_b1, &v[*m - *k + 1 + v_dim1], ldv,
&v[*m - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12, (ftnlen)4);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
zgemm_((char *)"Conjugate transpose", (char *)"No transpose", n, k, &i__1, &c_b1, zgemm_((char *)"C", (char *)"N", n, k, &i__1, &c_b1, &c__[c_offset], ldc, &v[v_offset], ldv,
&c__[c_offset], ldc, &v[v_offset], ldv, &c_b1, &work[work_offset], &c_b1, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1);
ldwork, (ftnlen)19, (ftnlen)12);
} }
ztrmm_((char *)"Right", (char *)"Lower", transt, (char *)"Non-unit", n, k, &c_b1, &t[t_offset], ldt, ztrmm_((char *)"R", (char *)"L", transt, (char *)"N", n, k, &c_b1, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"Conjugate transpose", &i__1, n, k, &z__1, &v[v_offset], zgemm_((char *)"N", (char *)"C", &i__1, n, k, &z__1, &v[v_offset], ldv, &work[work_offset],
ldv, &work[work_offset], ldwork, &c_b1, &c__[c_offset], ldc, (ftnlen)12, ldwork, &c_b1, &c__[c_offset], ldc, (ftnlen)1, (ftnlen)1);
(ftnlen)19);
} }
ztrmm_((char *)"Right", (char *)"Upper", (char *)"Conjugate transpose", (char *)"Unit", n, k, &c_b1, ztrmm_((char *)"R", (char *)"U", (char *)"C", (char *)"U", n, k, &c_b1, &v[*m - *k + 1 + v_dim1], ldv,
&v[*m - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)19, (ftnlen)4);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *n; i__2 = *n;
@ -165,27 +159,23 @@ int zlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
zcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], zcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1],
&c__1); &c__1);
} }
ztrmm_((char *)"Right", (char *)"Upper", (char *)"No transpose", (char *)"Unit", m, k, &c_b1, ztrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"U", m, k, &c_b1, &v[*n - *k + 1 + v_dim1], ldv,
&v[*n - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12, (ftnlen)4);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
zgemm_((char *)"No transpose", (char *)"No transpose", m, k, &i__1, &c_b1, &c__[c_offset], ldc, zgemm_((char *)"N", (char *)"N", m, k, &i__1, &c_b1, &c__[c_offset], ldc, &v[v_offset], ldv,
&v[v_offset], ldv, &c_b1, &work[work_offset], ldwork, (ftnlen)12, &c_b1, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1);
(ftnlen)12);
} }
ztrmm_((char *)"Right", (char *)"Lower", trans, (char *)"Non-unit", m, k, &c_b1, &t[t_offset], ldt, ztrmm_((char *)"R", (char *)"L", trans, (char *)"N", m, k, &c_b1, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"Conjugate transpose", m, &i__1, k, &z__1, zgemm_((char *)"N", (char *)"C", m, &i__1, k, &z__1, &work[work_offset], ldwork, &v[v_offset],
&work[work_offset], ldwork, &v[v_offset], ldv, &c_b1, &c__[c_offset], ldv, &c_b1, &c__[c_offset], ldc, (ftnlen)1, (ftnlen)1);
ldc, (ftnlen)12, (ftnlen)19);
} }
ztrmm_((char *)"Right", (char *)"Upper", (char *)"Conjugate transpose", (char *)"Unit", m, k, &c_b1, ztrmm_((char *)"R", (char *)"U", (char *)"C", (char *)"U", m, k, &c_b1, &v[*n - *k + 1 + v_dim1], ldv,
&v[*n - *k + 1 + v_dim1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)19, (ftnlen)4);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *m; i__2 = *m;
@ -207,26 +197,25 @@ int zlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
zcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); zcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1);
zlacgv_(n, &work[j * work_dim1 + 1], &c__1); zlacgv_(n, &work[j * work_dim1 + 1], &c__1);
} }
ztrmm_((char *)"Right", (char *)"Upper", (char *)"Conjugate transpose", (char *)"Unit", n, k, &c_b1, &v[v_offset], ztrmm_((char *)"R", (char *)"U", (char *)"C", (char *)"U", n, k, &c_b1, &v[v_offset], ldv, &work[work_offset],
ldv, &work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)19, ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)4);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
zgemm_((char *)"Conjugate transpose", (char *)"Conjugate transpose", n, k, &i__1, &c_b1, zgemm_((char *)"C", (char *)"C", n, k, &i__1, &c_b1, &c__[*k + 1 + c_dim1], ldc,
&c__[*k + 1 + c_dim1], ldc, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b1, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b1, &work[work_offset], ldwork,
&work[work_offset], ldwork, (ftnlen)19, (ftnlen)19); (ftnlen)1, (ftnlen)1);
} }
ztrmm_((char *)"Right", (char *)"Upper", transt, (char *)"Non-unit", n, k, &c_b1, &t[t_offset], ldt, ztrmm_((char *)"R", (char *)"U", transt, (char *)"N", n, k, &c_b1, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"Conjugate transpose", (char *)"Conjugate transpose", &i__1, n, k, &z__1, zgemm_((char *)"C", (char *)"C", &i__1, n, k, &z__1, &v[(*k + 1) * v_dim1 + 1], ldv,
&v[(*k + 1) * v_dim1 + 1], ldv, &work[work_offset], ldwork, &c_b1, &work[work_offset], ldwork, &c_b1, &c__[*k + 1 + c_dim1], ldc, (ftnlen)1,
&c__[*k + 1 + c_dim1], ldc, (ftnlen)19, (ftnlen)19); (ftnlen)1);
} }
ztrmm_((char *)"Right", (char *)"Upper", (char *)"No transpose", (char *)"Unit", n, k, &c_b1, &v[v_offset], ldv, ztrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"U", n, k, &c_b1, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *n; i__2 = *n;
@ -243,26 +232,25 @@ int zlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
zcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], &c__1); zcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], &c__1);
} }
ztrmm_((char *)"Right", (char *)"Upper", (char *)"Conjugate transpose", (char *)"Unit", m, k, &c_b1, &v[v_offset], ztrmm_((char *)"R", (char *)"U", (char *)"C", (char *)"U", m, k, &c_b1, &v[v_offset], ldv, &work[work_offset],
ldv, &work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)19, ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)4);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
zgemm_((char *)"No transpose", (char *)"Conjugate transpose", m, k, &i__1, &c_b1, zgemm_((char *)"N", (char *)"C", m, k, &i__1, &c_b1, &c__[(*k + 1) * c_dim1 + 1], ldc,
&c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b1, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b1, &work[work_offset], ldwork,
&work[work_offset], ldwork, (ftnlen)12, (ftnlen)19); (ftnlen)1, (ftnlen)1);
} }
ztrmm_((char *)"Right", (char *)"Upper", trans, (char *)"Non-unit", m, k, &c_b1, &t[t_offset], ldt, ztrmm_((char *)"R", (char *)"U", trans, (char *)"N", m, k, &c_b1, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"No transpose", m, &i__1, k, &z__1, &work[work_offset], zgemm_((char *)"N", (char *)"N", m, &i__1, k, &z__1, &work[work_offset], ldwork,
ldwork, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b1, &v[(*k + 1) * v_dim1 + 1], ldv, &c_b1, &c__[(*k + 1) * c_dim1 + 1], ldc,
&c__[(*k + 1) * c_dim1 + 1], ldc, (ftnlen)12, (ftnlen)12); (ftnlen)1, (ftnlen)1);
} }
ztrmm_((char *)"Right", (char *)"Upper", (char *)"No transpose", (char *)"Unit", m, k, &c_b1, &v[v_offset], ldv, ztrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"U", m, k, &c_b1, &v[v_offset], ldv, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *m; i__2 = *m;
@ -282,27 +270,23 @@ int zlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
zcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1); zcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j * work_dim1 + 1], &c__1);
zlacgv_(n, &work[j * work_dim1 + 1], &c__1); zlacgv_(n, &work[j * work_dim1 + 1], &c__1);
} }
ztrmm_((char *)"Right", (char *)"Lower", (char *)"Conjugate transpose", (char *)"Unit", n, k, &c_b1, ztrmm_((char *)"R", (char *)"L", (char *)"C", (char *)"U", n, k, &c_b1, &v[(*m - *k + 1) * v_dim1 + 1], ldv,
&v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)19, (ftnlen)4);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
zgemm_((char *)"Conjugate transpose", (char *)"Conjugate transpose", n, k, &i__1, &c_b1, zgemm_((char *)"C", (char *)"C", n, k, &i__1, &c_b1, &c__[c_offset], ldc, &v[v_offset], ldv,
&c__[c_offset], ldc, &v[v_offset], ldv, &c_b1, &work[work_offset], &c_b1, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1);
ldwork, (ftnlen)19, (ftnlen)19);
} }
ztrmm_((char *)"Right", (char *)"Lower", transt, (char *)"Non-unit", n, k, &c_b1, &t[t_offset], ldt, ztrmm_((char *)"R", (char *)"L", transt, (char *)"N", n, k, &c_b1, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*m > *k) { if (*m > *k) {
i__1 = *m - *k; i__1 = *m - *k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"Conjugate transpose", (char *)"Conjugate transpose", &i__1, n, k, &z__1, zgemm_((char *)"C", (char *)"C", &i__1, n, k, &z__1, &v[v_offset], ldv, &work[work_offset],
&v[v_offset], ldv, &work[work_offset], ldwork, &c_b1, &c__[c_offset], ldwork, &c_b1, &c__[c_offset], ldc, (ftnlen)1, (ftnlen)1);
ldc, (ftnlen)19, (ftnlen)19);
} }
ztrmm_((char *)"Right", (char *)"Lower", (char *)"No transpose", (char *)"Unit", n, k, &c_b1, ztrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"U", n, k, &c_b1, &v[(*m - *k + 1) * v_dim1 + 1], ldv,
&v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12, (ftnlen)4);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *n; i__2 = *n;
@ -320,27 +304,23 @@ int zlarfb_(char *side, char *trans, char *direct, char *storev, integer *m, int
zcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1], zcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[j * work_dim1 + 1],
&c__1); &c__1);
} }
ztrmm_((char *)"Right", (char *)"Lower", (char *)"Conjugate transpose", (char *)"Unit", m, k, &c_b1, ztrmm_((char *)"R", (char *)"L", (char *)"C", (char *)"U", m, k, &c_b1, &v[(*n - *k + 1) * v_dim1 + 1], ldv,
&v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)19, (ftnlen)4);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
zgemm_((char *)"No transpose", (char *)"Conjugate transpose", m, k, &i__1, &c_b1, zgemm_((char *)"N", (char *)"C", m, k, &i__1, &c_b1, &c__[c_offset], ldc, &v[v_offset], ldv,
&c__[c_offset], ldc, &v[v_offset], ldv, &c_b1, &work[work_offset], &c_b1, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1);
ldwork, (ftnlen)12, (ftnlen)19);
} }
ztrmm_((char *)"Right", (char *)"Lower", trans, (char *)"Non-unit", m, k, &c_b1, &t[t_offset], ldt, ztrmm_((char *)"R", (char *)"L", trans, (char *)"N", m, k, &c_b1, &t[t_offset], ldt, &work[work_offset],
&work[work_offset], ldwork, (ftnlen)5, (ftnlen)5, (ftnlen)1, (ftnlen)8); ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*n > *k) { if (*n > *k) {
i__1 = *n - *k; i__1 = *n - *k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"No transpose", m, &i__1, k, &z__1, &work[work_offset], zgemm_((char *)"N", (char *)"N", m, &i__1, k, &z__1, &work[work_offset], ldwork, &v[v_offset],
ldwork, &v[v_offset], ldv, &c_b1, &c__[c_offset], ldc, (ftnlen)12, ldv, &c_b1, &c__[c_offset], ldc, (ftnlen)1, (ftnlen)1);
(ftnlen)12);
} }
ztrmm_((char *)"Right", (char *)"Lower", (char *)"No transpose", (char *)"Unit", m, k, &c_b1, ztrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"U", m, k, &c_b1, &v[(*n - *k + 1) * v_dim1 + 1], ldv,
&v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[work_offset], ldwork, (ftnlen)5, &work[work_offset], ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12, (ftnlen)4);
i__1 = *k; i__1 = *k;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = *m; i__2 = *m;

76
lib/linalg/zlasyf.cpp
View File

@ -7,20 +7,17 @@ static integer c__1 = 1;
int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a, integer *lda, int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a, integer *lda,
integer *ipiv, doublecomplex *w, integer *ldw, integer *info, ftnlen uplo_len) integer *ipiv, doublecomplex *w, integer *ldw, integer *info, ftnlen uplo_len)
{ {
integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4, i__5; integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
doublereal d__1, d__2, d__3, d__4; doublereal d__1, d__2, d__3, d__4;
doublecomplex z__1, z__2, z__3; doublecomplex z__1, z__2, z__3;
double sqrt(doublereal), d_lmp_imag(doublecomplex *); double sqrt(doublereal), d_lmp_imag(doublecomplex *);
void z_lmp_div(doublecomplex *, doublecomplex *, doublecomplex *); void z_lmp_div(doublecomplex *, doublecomplex *, doublecomplex *);
integer j, k; integer j, k;
doublecomplex t, r1, d11, d21, d22; doublecomplex t, r1, d11, d21, d22;
integer jb, jj, kk, jp, kp, kw, kkw, imax, jmax; integer jj, kk, jp, kp, kw, kkw, imax, jmax;
doublereal alpha; doublereal alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), extern int zscal_(integer *, doublecomplex *, doublecomplex *, integer *);
zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *,
integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *,
ftnlen, ftnlen);
integer kstep; integer kstep;
extern int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, extern int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *,
@ -30,6 +27,9 @@ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
doublereal absakk, colmax; doublereal absakk, colmax;
extern integer izamax_(integer *, doublecomplex *, integer *); extern integer izamax_(integer *, doublecomplex *, integer *);
doublereal rowmax; doublereal rowmax;
extern int zgemmtr_(char *, char *, char *, integer *, integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *,
doublecomplex *, integer *, ftnlen, ftnlen, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -50,8 +50,8 @@ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
if (k < *n) { if (k < *n) {
i__1 = *n - k; i__1 = *n - k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda, zgemv_((char *)"N", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda, &w[k + (kw + 1) * w_dim1],
&w[k + (kw + 1) * w_dim1], ldw, &c_b1, &w[kw * w_dim1 + 1], &c__1, (ftnlen)12); ldw, &c_b1, &w[kw * w_dim1 + 1], &c__1, (ftnlen)1);
} }
kstep = 1; kstep = 1;
i__1 = k + kw * w_dim1; i__1 = k + kw * w_dim1;
@ -81,9 +81,9 @@ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
if (k < *n) { if (k < *n) {
i__1 = *n - k; i__1 = *n - k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda, zgemv_((char *)"N", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda,
&w[imax + (kw + 1) * w_dim1], ldw, &c_b1, &w[(kw - 1) * w_dim1 + 1], &w[imax + (kw + 1) * w_dim1], ldw, &c_b1, &w[(kw - 1) * w_dim1 + 1],
&c__1, (ftnlen)12); &c__1, (ftnlen)1);
} }
i__1 = k - imax; i__1 = k - imax;
jmax = imax + izamax_(&i__1, &w[imax + 1 + (kw - 1) * w_dim1], &c__1); jmax = imax + izamax_(&i__1, &w[imax + 1 + (kw - 1) * w_dim1], &c__1);
@ -194,26 +194,11 @@ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
k -= kstep; k -= kstep;
goto L10; goto L10;
L30: L30:
i__1 = -(*nb); i__1 = *n - k;
for (j = (k - 1) / *nb * *nb + 1; i__1 < 0 ? j >= 1 : j <= 1; j += i__1) {
i__2 = *nb, i__3 = k - j + 1;
jb = min(i__2, i__3);
i__2 = j + jb - 1;
for (jj = j; jj <= i__2; ++jj) {
i__3 = jj - j + 1;
i__4 = *n - k;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__3, &i__4, &z__1, &a[j + (k + 1) * a_dim1], lda, zgemmtr_((char *)"U", (char *)"N", (char *)"T", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda,
&w[jj + (kw + 1) * w_dim1], ldw, &c_b1, &a[j + jj * a_dim1], &c__1, &w[(kw + 1) * w_dim1 + 1], ldw, &c_b1, &a[a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1,
(ftnlen)12); (ftnlen)1);
}
i__2 = j - 1;
i__3 = *n - k;
z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"Transpose", &i__2, &jb, &i__3, &z__1, &a[(k + 1) * a_dim1 + 1],
lda, &w[j + (kw + 1) * w_dim1], ldw, &c_b1, &a[j * a_dim1 + 1], lda, (ftnlen)12,
(ftnlen)9);
}
j = k + 1; j = k + 1;
L60: L60:
jj = j; jj = j;
@ -242,8 +227,8 @@ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
i__1 = *n - k + 1; i__1 = *n - k + 1;
i__2 = k - 1; i__2 = k - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[k + w_dim1], ldw, &c_b1, zgemv_((char *)"N", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[k + w_dim1], ldw, &c_b1,
&w[k + k * w_dim1], &c__1, (ftnlen)12); &w[k + k * w_dim1], &c__1, (ftnlen)1);
kstep = 1; kstep = 1;
i__1 = k + k * w_dim1; i__1 = k + k * w_dim1;
absakk = (d__1 = w[i__1].r, abs(d__1)) + (d__2 = d_lmp_imag(&w[k + k * w_dim1]), abs(d__2)); absakk = (d__1 = w[i__1].r, abs(d__1)) + (d__2 = d_lmp_imag(&w[k + k * w_dim1]), abs(d__2));
@ -272,8 +257,8 @@ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
i__1 = *n - k + 1; i__1 = *n - k + 1;
i__2 = k - 1; i__2 = k - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[imax + w_dim1], zgemv_((char *)"N", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[imax + w_dim1], ldw, &c_b1,
ldw, &c_b1, &w[k + (k + 1) * w_dim1], &c__1, (ftnlen)12); &w[k + (k + 1) * w_dim1], &c__1, (ftnlen)1);
i__1 = imax - k; i__1 = imax - k;
jmax = k - 1 + izamax_(&i__1, &w[k + (k + 1) * w_dim1], &c__1); jmax = k - 1 + izamax_(&i__1, &w[k + (k + 1) * w_dim1], &c__1);
i__1 = jmax + (k + 1) * w_dim1; i__1 = jmax + (k + 1) * w_dim1;
@ -385,28 +370,11 @@ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
k += kstep; k += kstep;
goto L70; goto L70;
L90: L90:
i__1 = *n; i__1 = *n - k + 1;
i__2 = *nb; i__2 = k - 1;
for (j = k; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
i__3 = *nb, i__4 = *n - j + 1;
jb = min(i__3, i__4);
i__3 = j + jb - 1;
for (jj = j; jj <= i__3; ++jj) {
i__4 = j + jb - jj;
i__5 = k - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__4, &i__5, &z__1, &a[jj + a_dim1], lda, &w[jj + w_dim1], zgemmtr_((char *)"L", (char *)"N", (char *)"T", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[k + w_dim1], ldw,
ldw, &c_b1, &a[jj + jj * a_dim1], &c__1, (ftnlen)12); &c_b1, &a[k + k * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1);
}
if (j + jb <= *n) {
i__3 = *n - j - jb + 1;
i__4 = k - 1;
z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"Transpose", &i__3, &jb, &i__4, &z__1, &a[j + jb + a_dim1],
lda, &w[j + w_dim1], ldw, &c_b1, &a[j + jb + j * a_dim1], lda, (ftnlen)12,
(ftnlen)9);
}
}
j = k - 1; j = k - 1;
L120: L120:
jj = j; jj = j;

62
lib/linalg/zlatrd.cpp
View File

@ -49,18 +49,18 @@ int zlatrd_(char *uplo, integer *n, integer *nb, doublecomplex *a, integer *lda,
zlacgv_(&i__2, &w[i__ + (iw + 1) * w_dim1], ldw); zlacgv_(&i__2, &w[i__ + (iw + 1) * w_dim1], ldw);
i__2 = *n - i__; i__2 = *n - i__;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__, &i__2, &z__1, &a[(i__ + 1) * a_dim1 + 1], lda, zgemv_((char *)"N", &i__, &i__2, &z__1, &a[(i__ + 1) * a_dim1 + 1], lda,
&w[i__ + (iw + 1) * w_dim1], ldw, &c_b2, &a[i__ * a_dim1 + 1], &c__1, &w[i__ + (iw + 1) * w_dim1], ldw, &c_b2, &a[i__ * a_dim1 + 1], &c__1,
(ftnlen)12); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
zlacgv_(&i__2, &w[i__ + (iw + 1) * w_dim1], ldw); zlacgv_(&i__2, &w[i__ + (iw + 1) * w_dim1], ldw);
i__2 = *n - i__; i__2 = *n - i__;
zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda); zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda);
i__2 = *n - i__; i__2 = *n - i__;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__, &i__2, &z__1, &w[(iw + 1) * w_dim1 + 1], ldw, zgemv_((char *)"N", &i__, &i__2, &z__1, &w[(iw + 1) * w_dim1 + 1], ldw,
&a[i__ + (i__ + 1) * a_dim1], lda, &c_b2, &a[i__ * a_dim1 + 1], &c__1, &a[i__ + (i__ + 1) * a_dim1], lda, &c_b2, &a[i__ * a_dim1 + 1], &c__1,
(ftnlen)12); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda); zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda);
i__2 = i__ + i__ * a_dim1; i__2 = i__ + i__ * a_dim1;
@ -77,31 +77,31 @@ int zlatrd_(char *uplo, integer *n, integer *nb, doublecomplex *a, integer *lda,
i__2 = i__ - 1 + i__ * a_dim1; i__2 = i__ - 1 + i__ * a_dim1;
a[i__2].r = 1., a[i__2].i = 0.; a[i__2].r = 1., a[i__2].i = 0.;
i__2 = i__ - 1; i__2 = i__ - 1;
zhemv_((char *)"Upper", &i__2, &c_b2, &a[a_offset], lda, &a[i__ * a_dim1 + 1], &c__1, &c_b1, zhemv_((char *)"U", &i__2, &c_b2, &a[a_offset], lda, &a[i__ * a_dim1 + 1], &c__1, &c_b1,
&w[iw * w_dim1 + 1], &c__1, (ftnlen)5); &w[iw * w_dim1 + 1], &c__1, (ftnlen)1);
if (i__ < *n) { if (i__ < *n) {
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
zgemv_((char *)"Conjugate transpose", &i__2, &i__3, &c_b2, &w[(iw + 1) * w_dim1 + 1], zgemv_((char *)"C", &i__2, &i__3, &c_b2, &w[(iw + 1) * w_dim1 + 1], ldw,
ldw, &a[i__ * a_dim1 + 1], &c__1, &c_b1, &w[i__ + 1 + iw * w_dim1], &a[i__ * a_dim1 + 1], &c__1, &c_b1, &w[i__ + 1 + iw * w_dim1], &c__1,
&c__1, (ftnlen)19); (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__2, &i__3, &z__1, &a[(i__ + 1) * a_dim1 + 1], lda, zgemv_((char *)"N", &i__2, &i__3, &z__1, &a[(i__ + 1) * a_dim1 + 1], lda,
&w[i__ + 1 + iw * w_dim1], &c__1, &c_b2, &w[iw * w_dim1 + 1], &c__1, &w[i__ + 1 + iw * w_dim1], &c__1, &c_b2, &w[iw * w_dim1 + 1], &c__1,
(ftnlen)12); (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
zgemv_((char *)"Conjugate transpose", &i__2, &i__3, &c_b2, &a[(i__ + 1) * a_dim1 + 1], zgemv_((char *)"C", &i__2, &i__3, &c_b2, &a[(i__ + 1) * a_dim1 + 1], lda,
lda, &a[i__ * a_dim1 + 1], &c__1, &c_b1, &w[i__ + 1 + iw * w_dim1], &a[i__ * a_dim1 + 1], &c__1, &c_b1, &w[i__ + 1 + iw * w_dim1], &c__1,
&c__1, (ftnlen)19); (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__2, &i__3, &z__1, &w[(iw + 1) * w_dim1 + 1], ldw, zgemv_((char *)"N", &i__2, &i__3, &z__1, &w[(iw + 1) * w_dim1 + 1], ldw,
&w[i__ + 1 + iw * w_dim1], &c__1, &c_b2, &w[iw * w_dim1 + 1], &c__1, &w[i__ + 1 + iw * w_dim1], &c__1, &c_b2, &w[iw * w_dim1 + 1], &c__1,
(ftnlen)12); (ftnlen)1);
} }
i__2 = i__ - 1; i__2 = i__ - 1;
zscal_(&i__2, &tau[i__ - 1], &w[iw * w_dim1 + 1], &c__1); zscal_(&i__2, &tau[i__ - 1], &w[iw * w_dim1 + 1], &c__1);
@ -130,8 +130,8 @@ int zlatrd_(char *uplo, integer *n, integer *nb, doublecomplex *a, integer *lda,
i__2 = *n - i__ + 1; i__2 = *n - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__2, &i__3, &z__1, &a[i__ + a_dim1], lda, &w[i__ + w_dim1], zgemv_((char *)"N", &i__2, &i__3, &z__1, &a[i__ + a_dim1], lda, &w[i__ + w_dim1], ldw, &c_b2,
ldw, &c_b2, &a[i__ + i__ * a_dim1], &c__1, (ftnlen)12); &a[i__ + i__ * a_dim1], &c__1, (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
zlacgv_(&i__2, &w[i__ + w_dim1], ldw); zlacgv_(&i__2, &w[i__ + w_dim1], ldw);
i__2 = i__ - 1; i__2 = i__ - 1;
@ -139,8 +139,8 @@ int zlatrd_(char *uplo, integer *n, integer *nb, doublecomplex *a, integer *lda,
i__2 = *n - i__ + 1; i__2 = *n - i__ + 1;
i__3 = i__ - 1; i__3 = i__ - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__2, &i__3, &z__1, &w[i__ + w_dim1], ldw, &a[i__ + a_dim1], zgemv_((char *)"N", &i__2, &i__3, &z__1, &w[i__ + w_dim1], ldw, &a[i__ + a_dim1], lda, &c_b2,
lda, &c_b2, &a[i__ + i__ * a_dim1], &c__1, (ftnlen)12); &a[i__ + i__ * a_dim1], &c__1, (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
zlacgv_(&i__2, &a[i__ + a_dim1], lda); zlacgv_(&i__2, &a[i__ + a_dim1], lda);
i__2 = i__ + i__ * a_dim1; i__2 = i__ + i__ * a_dim1;
@ -157,31 +157,29 @@ int zlatrd_(char *uplo, integer *n, integer *nb, doublecomplex *a, integer *lda,
i__2 = i__ + 1 + i__ * a_dim1; i__2 = i__ + 1 + i__ * a_dim1;
a[i__2].r = 1., a[i__2].i = 0.; a[i__2].r = 1., a[i__2].i = 0.;
i__2 = *n - i__; i__2 = *n - i__;
zhemv_((char *)"Lower", &i__2, &c_b2, &a[i__ + 1 + (i__ + 1) * a_dim1], lda, zhemv_((char *)"L", &i__2, &c_b2, &a[i__ + 1 + (i__ + 1) * a_dim1], lda,
&a[i__ + 1 + i__ * a_dim1], &c__1, &c_b1, &w[i__ + 1 + i__ * w_dim1], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b1, &w[i__ + 1 + i__ * w_dim1], &c__1,
(ftnlen)5); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
zgemv_((char *)"Conjugate transpose", &i__2, &i__3, &c_b2, &w[i__ + 1 + w_dim1], ldw, zgemv_((char *)"C", &i__2, &i__3, &c_b2, &w[i__ + 1 + w_dim1], ldw,
&a[i__ + 1 + i__ * a_dim1], &c__1, &c_b1, &w[i__ * w_dim1 + 1], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b1, &w[i__ * w_dim1 + 1], &c__1,
(ftnlen)19); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__2, &i__3, &z__1, &a[i__ + 1 + a_dim1], lda, zgemv_((char *)"N", &i__2, &i__3, &z__1, &a[i__ + 1 + a_dim1], lda, &w[i__ * w_dim1 + 1],
&w[i__ * w_dim1 + 1], &c__1, &c_b2, &w[i__ + 1 + i__ * w_dim1], &c__1, &c__1, &c_b2, &w[i__ + 1 + i__ * w_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
zgemv_((char *)"Conjugate transpose", &i__2, &i__3, &c_b2, &a[i__ + 1 + a_dim1], lda, zgemv_((char *)"C", &i__2, &i__3, &c_b2, &a[i__ + 1 + a_dim1], lda,
&a[i__ + 1 + i__ * a_dim1], &c__1, &c_b1, &w[i__ * w_dim1 + 1], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b1, &w[i__ * w_dim1 + 1], &c__1,
(ftnlen)19); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &i__2, &i__3, &z__1, &w[i__ + 1 + w_dim1], ldw, zgemv_((char *)"N", &i__2, &i__3, &z__1, &w[i__ + 1 + w_dim1], ldw, &w[i__ * w_dim1 + 1],
&w[i__ * w_dim1 + 1], &c__1, &c_b2, &w[i__ + 1 + i__ * w_dim1], &c__1, &c__1, &c_b2, &w[i__ + 1 + i__ * w_dim1], &c__1, (ftnlen)1);
(ftnlen)12);
i__2 = *n - i__; i__2 = *n - i__;
zscal_(&i__2, &tau[i__], &w[i__ + 1 + i__ * w_dim1], &c__1); zscal_(&i__2, &tau[i__], &w[i__ + 1 + i__ * w_dim1], &c__1);
z__3.r = -.5, z__3.i = -0.; z__3.r = -.5, z__3.i = -0.;

8
lib/linalg/zlauu2.cpp
View File

@ -58,9 +58,9 @@ int zlauu2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *inf
i__2 = i__ - 1; i__2 = i__ - 1;
i__3 = *n - i__; i__3 = *n - i__;
z__1.r = aii, z__1.i = 0.; z__1.r = aii, z__1.i = 0.;
zgemv_((char *)"No transpose", &i__2, &i__3, &c_b1, &a[(i__ + 1) * a_dim1 + 1], lda, zgemv_((char *)"N", &i__2, &i__3, &c_b1, &a[(i__ + 1) * a_dim1 + 1], lda,
&a[i__ + (i__ + 1) * a_dim1], lda, &z__1, &a[i__ * a_dim1 + 1], &c__1, &a[i__ + (i__ + 1) * a_dim1], lda, &z__1, &a[i__ * a_dim1 + 1], &c__1,
(ftnlen)12); (ftnlen)1);
i__2 = *n - i__; i__2 = *n - i__;
zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda); zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda);
} else { } else {
@ -84,8 +84,8 @@ int zlauu2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *inf
i__2 = *n - i__; i__2 = *n - i__;
i__3 = i__ - 1; i__3 = i__ - 1;
z__1.r = aii, z__1.i = 0.; z__1.r = aii, z__1.i = 0.;
zgemv_((char *)"Conjugate transpose", &i__2, &i__3, &c_b1, &a[i__ + 1 + a_dim1], lda, zgemv_((char *)"C", &i__2, &i__3, &c_b1, &a[i__ + 1 + a_dim1], lda,
&a[i__ + 1 + i__ * a_dim1], &c__1, &z__1, &a[i__ + a_dim1], lda, (ftnlen)19); &a[i__ + 1 + i__ * a_dim1], &c__1, &z__1, &a[i__ + a_dim1], lda, (ftnlen)1);
i__2 = i__ - 1; i__2 = i__ - 1;
zlacgv_(&i__2, &a[i__ + a_dim1], lda); zlacgv_(&i__2, &a[i__ + a_dim1], lda);
} else { } else {

36
lib/linalg/zlauum.cpp
View File

@ -55,20 +55,18 @@ int zlauum_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *inf
i__3 = nb, i__4 = *n - i__ + 1; i__3 = nb, i__4 = *n - i__ + 1;
ib = min(i__3, i__4); ib = min(i__3, i__4);
i__3 = i__ - 1; i__3 = i__ - 1;
ztrmm_((char *)"Right", (char *)"Upper", (char *)"Conjugate transpose", (char *)"Non-unit", &i__3, &ib, &c_b1, ztrmm_((char *)"R", (char *)"U", (char *)"C", (char *)"N", &i__3, &ib, &c_b1, &a[i__ + i__ * a_dim1], lda,
&a[i__ + i__ * a_dim1], lda, &a[i__ * a_dim1 + 1], lda, (ftnlen)5, (ftnlen)5, &a[i__ * a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)19, (ftnlen)8); zlauu2_((char *)"U", &ib, &a[i__ + i__ * a_dim1], lda, info, (ftnlen)1);
zlauu2_((char *)"Upper", &ib, &a[i__ + i__ * a_dim1], lda, info, (ftnlen)5);
if (i__ + ib <= *n) { if (i__ + ib <= *n) {
i__3 = i__ - 1; i__3 = i__ - 1;
i__4 = *n - i__ - ib + 1; i__4 = *n - i__ - ib + 1;
zgemm_((char *)"No transpose", (char *)"Conjugate transpose", &i__3, &ib, &i__4, &c_b1, zgemm_((char *)"N", (char *)"C", &i__3, &ib, &i__4, &c_b1, &a[(i__ + ib) * a_dim1 + 1], lda,
&a[(i__ + ib) * a_dim1 + 1], lda, &a[i__ + (i__ + ib) * a_dim1], lda, &a[i__ + (i__ + ib) * a_dim1], lda, &c_b1, &a[i__ * a_dim1 + 1], lda,
&c_b1, &a[i__ * a_dim1 + 1], lda, (ftnlen)12, (ftnlen)19); (ftnlen)1, (ftnlen)1);
i__3 = *n - i__ - ib + 1; i__3 = *n - i__ - ib + 1;
zherk_((char *)"Upper", (char *)"No transpose", &ib, &i__3, &c_b21, zherk_((char *)"U", (char *)"N", &ib, &i__3, &c_b21, &a[i__ + (i__ + ib) * a_dim1], lda, &c_b21,
&a[i__ + (i__ + ib) * a_dim1], lda, &c_b21, &a[i__ + i__ * a_dim1], lda, &a[i__ + i__ * a_dim1], lda, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)12);
} }
} }
} else { } else {
@ -78,20 +76,18 @@ int zlauum_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *inf
i__3 = nb, i__4 = *n - i__ + 1; i__3 = nb, i__4 = *n - i__ + 1;
ib = min(i__3, i__4); ib = min(i__3, i__4);
i__3 = i__ - 1; i__3 = i__ - 1;
ztrmm_((char *)"Left", (char *)"Lower", (char *)"Conjugate transpose", (char *)"Non-unit", &ib, &i__3, &c_b1, ztrmm_((char *)"L", (char *)"L", (char *)"C", (char *)"N", &ib, &i__3, &c_b1, &a[i__ + i__ * a_dim1], lda,
&a[i__ + i__ * a_dim1], lda, &a[i__ + a_dim1], lda, (ftnlen)4, (ftnlen)5, &a[i__ + a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)19, (ftnlen)8); zlauu2_((char *)"L", &ib, &a[i__ + i__ * a_dim1], lda, info, (ftnlen)1);
zlauu2_((char *)"Lower", &ib, &a[i__ + i__ * a_dim1], lda, info, (ftnlen)5);
if (i__ + ib <= *n) { if (i__ + ib <= *n) {
i__3 = i__ - 1; i__3 = i__ - 1;
i__4 = *n - i__ - ib + 1; i__4 = *n - i__ - ib + 1;
zgemm_((char *)"Conjugate transpose", (char *)"No transpose", &ib, &i__3, &i__4, &c_b1, zgemm_((char *)"C", (char *)"N", &ib, &i__3, &i__4, &c_b1, &a[i__ + ib + i__ * a_dim1], lda,
&a[i__ + ib + i__ * a_dim1], lda, &a[i__ + ib + a_dim1], lda, &c_b1, &a[i__ + ib + a_dim1], lda, &c_b1, &a[i__ + a_dim1], lda, (ftnlen)1,
&a[i__ + a_dim1], lda, (ftnlen)19, (ftnlen)12); (ftnlen)1);
i__3 = *n - i__ - ib + 1; i__3 = *n - i__ - ib + 1;
zherk_((char *)"Lower", (char *)"Conjugate transpose", &ib, &i__3, &c_b21, zherk_((char *)"L", (char *)"C", &ib, &i__3, &c_b21, &a[i__ + ib + i__ * a_dim1], lda, &c_b21,
&a[i__ + ib + i__ * a_dim1], lda, &c_b21, &a[i__ + i__ * a_dim1], lda, &a[i__ + i__ * a_dim1], lda, (ftnlen)1, (ftnlen)1);
(ftnlen)5, (ftnlen)19);
} }
} }
} }

36
lib/linalg/zpotrf.cpp
View File

@ -57,9 +57,9 @@ int zpotrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *inf
i__3 = nb, i__4 = *n - j + 1; i__3 = nb, i__4 = *n - j + 1;
jb = min(i__3, i__4); jb = min(i__3, i__4);
i__3 = j - 1; i__3 = j - 1;
zherk_((char *)"Upper", (char *)"Conjugate transpose", &jb, &i__3, &c_b14, &a[j * a_dim1 + 1], lda, zherk_((char *)"U", (char *)"C", &jb, &i__3, &c_b14, &a[j * a_dim1 + 1], lda, &c_b15,
&c_b15, &a[j + j * a_dim1], lda, (ftnlen)5, (ftnlen)19); &a[j + j * a_dim1], lda, (ftnlen)1, (ftnlen)1);
zpotrf2_((char *)"Upper", &jb, &a[j + j * a_dim1], lda, info, (ftnlen)5); zpotrf2_((char *)"U", &jb, &a[j + j * a_dim1], lda, info, (ftnlen)1);
if (*info != 0) { if (*info != 0) {
goto L30; goto L30;
} }
@ -67,13 +67,13 @@ int zpotrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *inf
i__3 = *n - j - jb + 1; i__3 = *n - j - jb + 1;
i__4 = j - 1; i__4 = j - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"Conjugate transpose", (char *)"No transpose", &jb, &i__3, &i__4, &z__1, zgemm_((char *)"C", (char *)"N", &jb, &i__3, &i__4, &z__1, &a[j * a_dim1 + 1], lda,
&a[j * a_dim1 + 1], lda, &a[(j + jb) * a_dim1 + 1], lda, &c_b1, &a[(j + jb) * a_dim1 + 1], lda, &c_b1, &a[j + (j + jb) * a_dim1], lda,
&a[j + (j + jb) * a_dim1], lda, (ftnlen)19, (ftnlen)12); (ftnlen)1, (ftnlen)1);
i__3 = *n - j - jb + 1; i__3 = *n - j - jb + 1;
ztrsm_((char *)"Left", (char *)"Upper", (char *)"Conjugate transpose", (char *)"Non-unit", &jb, &i__3, &c_b1, ztrsm_((char *)"L", (char *)"U", (char *)"C", (char *)"N", &jb, &i__3, &c_b1, &a[j + j * a_dim1], lda,
&a[j + j * a_dim1], lda, &a[j + (j + jb) * a_dim1], lda, (ftnlen)4, &a[j + (j + jb) * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)5, (ftnlen)19, (ftnlen)8); (ftnlen)1);
} }
} }
} else { } else {
@ -83,9 +83,9 @@ int zpotrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *inf
i__3 = nb, i__4 = *n - j + 1; i__3 = nb, i__4 = *n - j + 1;
jb = min(i__3, i__4); jb = min(i__3, i__4);
i__3 = j - 1; i__3 = j - 1;
zherk_((char *)"Lower", (char *)"No transpose", &jb, &i__3, &c_b14, &a[j + a_dim1], lda, &c_b15, zherk_((char *)"L", (char *)"N", &jb, &i__3, &c_b14, &a[j + a_dim1], lda, &c_b15,
&a[j + j * a_dim1], lda, (ftnlen)5, (ftnlen)12); &a[j + j * a_dim1], lda, (ftnlen)1, (ftnlen)1);
zpotrf2_((char *)"Lower", &jb, &a[j + j * a_dim1], lda, info, (ftnlen)5); zpotrf2_((char *)"L", &jb, &a[j + j * a_dim1], lda, info, (ftnlen)1);
if (*info != 0) { if (*info != 0) {
goto L30; goto L30;
} }
@ -93,13 +93,13 @@ int zpotrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *inf
i__3 = *n - j - jb + 1; i__3 = *n - j - jb + 1;
i__4 = j - 1; i__4 = j - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
zgemm_((char *)"No transpose", (char *)"Conjugate transpose", &i__3, &jb, &i__4, &z__1, zgemm_((char *)"N", (char *)"C", &i__3, &jb, &i__4, &z__1, &a[j + jb + a_dim1], lda,
&a[j + jb + a_dim1], lda, &a[j + a_dim1], lda, &c_b1, &a[j + a_dim1], lda, &c_b1, &a[j + jb + j * a_dim1], lda, (ftnlen)1,
&a[j + jb + j * a_dim1], lda, (ftnlen)12, (ftnlen)19); (ftnlen)1);
i__3 = *n - j - jb + 1; i__3 = *n - j - jb + 1;
ztrsm_((char *)"Right", (char *)"Lower", (char *)"Conjugate transpose", (char *)"Non-unit", &i__3, &jb, &c_b1, ztrsm_((char *)"R", (char *)"L", (char *)"C", (char *)"N", &i__3, &jb, &c_b1, &a[j + j * a_dim1], lda,
&a[j + j * a_dim1], lda, &a[j + jb + j * a_dim1], lda, (ftnlen)5, &a[j + jb + j * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)5, (ftnlen)19, (ftnlen)8); (ftnlen)1);
} }
} }
} }

2
lib/linalg/zpotri.cpp
View File

@ -28,7 +28,7 @@ int zpotri_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *inf
if (*n == 0) { if (*n == 0) {
return 0; return 0;
} }
ztrtri_(uplo, (char *)"Non-unit", n, &a[a_offset], lda, info, (ftnlen)1, (ftnlen)8); ztrtri_(uplo, (char *)"N", n, &a[a_offset], lda, info, (ftnlen)1, (ftnlen)1);
if (*info > 0) { if (*info > 0) {
return 0; return 0;
} }

6
lib/linalg/zpptrf.cpp
View File

@ -46,8 +46,8 @@ int zpptrf_(char *uplo, integer *n, doublecomplex *ap, integer *info, ftnlen upl
jj += j; jj += j;
if (j > 1) { if (j > 1) {
i__2 = j - 1; i__2 = j - 1;
ztpsv_((char *)"Upper", (char *)"Conjugate transpose", (char *)"Non-unit", &i__2, &ap[1], &ap[jc], &c__1, ztpsv_((char *)"U", (char *)"C", (char *)"N", &i__2, &ap[1], &ap[jc], &c__1, (ftnlen)1, (ftnlen)1,
(ftnlen)5, (ftnlen)19, (ftnlen)8); (ftnlen)1);
} }
i__2 = jj; i__2 = jj;
i__3 = j - 1; i__3 = j - 1;
@ -81,7 +81,7 @@ int zpptrf_(char *uplo, integer *n, doublecomplex *ap, integer *info, ftnlen upl
d__1 = 1. / ajj; d__1 = 1. / ajj;
zdscal_(&i__2, &d__1, &ap[jj + 1], &c__1); zdscal_(&i__2, &d__1, &ap[jj + 1], &c__1);
i__2 = *n - j; i__2 = *n - j;
zhpr_((char *)"Lower", &i__2, &c_b16, &ap[jj + 1], &c__1, &ap[jj + *n - j + 1], (ftnlen)5); zhpr_((char *)"L", &i__2, &c_b16, &ap[jj + 1], &c__1, &ap[jj + *n - j + 1], (ftnlen)1);
jj = jj + *n - j + 1; jj = jj + *n - j + 1;
} }
} }

8
lib/linalg/zpptri.cpp
View File

@ -39,7 +39,7 @@ int zpptri_(char *uplo, integer *n, doublecomplex *ap, integer *info, ftnlen upl
if (*n == 0) { if (*n == 0) {
return 0; return 0;
} }
ztptri_(uplo, (char *)"Non-unit", n, &ap[1], info, (ftnlen)1, (ftnlen)8); ztptri_(uplo, (char *)"N", n, &ap[1], info, (ftnlen)1, (ftnlen)1);
if (*info > 0) { if (*info > 0) {
return 0; return 0;
} }
@ -51,7 +51,7 @@ int zpptri_(char *uplo, integer *n, doublecomplex *ap, integer *info, ftnlen upl
jj += j; jj += j;
if (j > 1) { if (j > 1) {
i__2 = j - 1; i__2 = j - 1;
zhpr_((char *)"Upper", &i__2, &c_b8, &ap[jc], &c__1, &ap[1], (ftnlen)5); zhpr_((char *)"U", &i__2, &c_b8, &ap[jc], &c__1, &ap[1], (ftnlen)1);
} }
i__2 = jj; i__2 = jj;
ajj = ap[i__2].r; ajj = ap[i__2].r;
@ -69,8 +69,8 @@ int zpptri_(char *uplo, integer *n, doublecomplex *ap, integer *info, ftnlen upl
ap[i__2].r = d__1, ap[i__2].i = 0.; ap[i__2].r = d__1, ap[i__2].i = 0.;
if (j < *n) { if (j < *n) {
i__2 = *n - j; i__2 = *n - j;
ztpmv_((char *)"Lower", (char *)"Conjugate transpose", (char *)"Non-unit", &i__2, &ap[jjn], &ap[jj + 1], ztpmv_((char *)"L", (char *)"C", (char *)"N", &i__2, &ap[jjn], &ap[jj + 1], &c__1, (ftnlen)1, (ftnlen)1,
&c__1, (ftnlen)5, (ftnlen)19, (ftnlen)8); (ftnlen)1);
} }
jj = jjn; jj = jjn;
} }

6
lib/linalg/zstedc.cpp
View File

@ -107,7 +107,7 @@ int zstedc_(char *compz, integer *n, doublereal *d__, doublereal *e, doublecompl
liwmin = *n * 5 + 3; liwmin = *n * 5 + 3;
} }
work[1].r = (doublereal)lwmin, work[1].i = 0.; work[1].r = (doublereal)lwmin, work[1].i = 0.;
rwork[1] = (doublereal)lrwmin; rwork[1] = (real)lrwmin;
iwork[1] = liwmin; iwork[1] = liwmin;
if (*lwork < lwmin && !lquery) { if (*lwork < lwmin && !lquery) {
*info = -8; *info = -8;
@ -142,7 +142,7 @@ int zstedc_(char *compz, integer *n, doublereal *d__, doublereal *e, doublecompl
zsteqr_(compz, n, &d__[1], &e[1], &z__[z_offset], ldz, &rwork[1], info, (ftnlen)1); zsteqr_(compz, n, &d__[1], &e[1], &z__[z_offset], ldz, &rwork[1], info, (ftnlen)1);
} else { } else {
if (icompz == 2) { if (icompz == 2) {
dlaset_((char *)"Full", n, n, &c_b17, &c_b18, &rwork[1], n, (ftnlen)4); dlaset_((char *)"F", n, n, &c_b17, &c_b18, &rwork[1], n, (ftnlen)1);
ll = *n * *n + 1; ll = *n * *n + 1;
i__1 = *lrwork - ll + 1; i__1 = *lrwork - ll + 1;
dstedc_((char *)"I", n, &d__[1], &e[1], &rwork[1], n, &rwork[ll], &i__1, &iwork[1], liwork, dstedc_((char *)"I", n, &d__[1], &e[1], &rwork[1], n, &rwork[ll], &i__1, &iwork[1], liwork,
@ -228,7 +228,7 @@ int zstedc_(char *compz, integer *n, doublereal *d__, doublereal *e, doublecompl
} }
L70: L70:
work[1].r = (doublereal)lwmin, work[1].i = 0.; work[1].r = (doublereal)lwmin, work[1].i = 0.;
rwork[1] = (doublereal)lrwmin; rwork[1] = (real)lrwmin;
iwork[1] = liwmin; iwork[1] = liwmin;
return 0; return 0;
} }

2
lib/linalg/zsteqr.cpp
View File

@ -93,7 +93,7 @@ int zsteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublecompl
ssfmax = sqrt(safmax) / 3.; ssfmax = sqrt(safmax) / 3.;
ssfmin = sqrt(safmin) / eps2; ssfmin = sqrt(safmin) / eps2;
if (icompz == 2) { if (icompz == 2) {
zlaset_((char *)"Full", n, n, &c_b1, &c_b2, &z__[z_offset], ldz, (ftnlen)4); zlaset_((char *)"F", n, n, &c_b1, &c_b2, &z__[z_offset], ldz, (ftnlen)1);
} }
nmaxit = *n * 30; nmaxit = *n * 30;
jtot = 0; jtot = 0;

3
lib/linalg/zsytrf.cpp
View File

@ -41,7 +41,8 @@ int zsytrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi
} }
if (*info == 0) { if (*info == 0) {
nb = ilaenv_(&c__1, (char *)"ZSYTRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); nb = ilaenv_(&c__1, (char *)"ZSYTRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
lwkopt = *n * nb; i__1 = 1, i__2 = *n * nb;
lwkopt = max(i__1, i__2);
work[1].r = (doublereal)lwkopt, work[1].i = 0.; work[1].r = (doublereal)lwkopt, work[1].i = 0.;
} }
if (*info != 0) { if (*info != 0) {

7
lib/linalg/ztptri.cpp
View File

@ -76,8 +76,7 @@ int ztptri_(char *uplo, char *diag, integer *n, doublecomplex *ap, integer *info
ajj.r = z__1.r, ajj.i = z__1.i; ajj.r = z__1.r, ajj.i = z__1.i;
} }
i__2 = j - 1; i__2 = j - 1;
ztpmv_((char *)"Upper", (char *)"No transpose", diag, &i__2, &ap[1], &ap[jc], &c__1, (ftnlen)5, ztpmv_((char *)"U", (char *)"N", diag, &i__2, &ap[1], &ap[jc], &c__1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)12, (ftnlen)1);
i__2 = j - 1; i__2 = j - 1;
zscal_(&i__2, &ajj, &ap[jc], &c__1); zscal_(&i__2, &ajj, &ap[jc], &c__1);
jc += j; jc += j;
@ -98,8 +97,8 @@ int ztptri_(char *uplo, char *diag, integer *n, doublecomplex *ap, integer *info
} }
if (j < *n) { if (j < *n) {
i__1 = *n - j; i__1 = *n - j;
ztpmv_((char *)"Lower", (char *)"No transpose", diag, &i__1, &ap[jclast], &ap[jc + 1], &c__1, ztpmv_((char *)"L", (char *)"N", diag, &i__1, &ap[jclast], &ap[jc + 1], &c__1, (ftnlen)1, (ftnlen)1,
(ftnlen)5, (ftnlen)12, (ftnlen)1); (ftnlen)1);
i__1 = *n - j; i__1 = *n - j;
zscal_(&i__1, &ajj, &ap[jc + 1], &c__1); zscal_(&i__1, &ajj, &ap[jc + 1], &c__1);
} }

8
lib/linalg/ztrti2.cpp
View File

@ -54,8 +54,8 @@ int ztrti2_(char *uplo, char *diag, integer *n, doublecomplex *a, integer *lda,
ajj.r = z__1.r, ajj.i = z__1.i; ajj.r = z__1.r, ajj.i = z__1.i;
} }
i__2 = j - 1; i__2 = j - 1;
ztrmv_((char *)"Upper", (char *)"No transpose", diag, &i__2, &a[a_offset], lda, &a[j * a_dim1 + 1], ztrmv_((char *)"U", (char *)"N", diag, &i__2, &a[a_offset], lda, &a[j * a_dim1 + 1], &c__1, (ftnlen)1,
&c__1, (ftnlen)5, (ftnlen)12, (ftnlen)1); (ftnlen)1, (ftnlen)1);
i__2 = j - 1; i__2 = j - 1;
zscal_(&i__2, &ajj, &a[j * a_dim1 + 1], &c__1); zscal_(&i__2, &ajj, &a[j * a_dim1 + 1], &c__1);
} }
@ -74,8 +74,8 @@ int ztrti2_(char *uplo, char *diag, integer *n, doublecomplex *a, integer *lda,
} }
if (j < *n) { if (j < *n) {
i__1 = *n - j; i__1 = *n - j;
ztrmv_((char *)"Lower", (char *)"No transpose", diag, &i__1, &a[j + 1 + (j + 1) * a_dim1], lda, ztrmv_((char *)"L", (char *)"N", diag, &i__1, &a[j + 1 + (j + 1) * a_dim1], lda,
&a[j + 1 + j * a_dim1], &c__1, (ftnlen)5, (ftnlen)12, (ftnlen)1); &a[j + 1 + j * a_dim1], &c__1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__1 = *n - j; i__1 = *n - j;
zscal_(&i__1, &ajj, &a[j + 1 + j * a_dim1], &c__1); zscal_(&i__1, &ajj, &a[j + 1 + j * a_dim1], &c__1);
} }

25
lib/linalg/ztrtri.cpp
View File

@ -75,14 +75,13 @@ int ztrtri_(char *uplo, char *diag, integer *n, doublecomplex *a, integer *lda,
i__4 = nb, i__5 = *n - j + 1; i__4 = nb, i__5 = *n - j + 1;
jb = min(i__4, i__5); jb = min(i__4, i__5);
i__4 = j - 1; i__4 = j - 1;
ztrmm_((char *)"Left", (char *)"Upper", (char *)"No transpose", diag, &i__4, &jb, &c_b1, &a[a_offset], lda, ztrmm_((char *)"L", (char *)"U", (char *)"N", diag, &i__4, &jb, &c_b1, &a[a_offset], lda,
&a[j * a_dim1 + 1], lda, (ftnlen)4, (ftnlen)5, (ftnlen)12, (ftnlen)1); &a[j * a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
i__4 = j - 1; i__4 = j - 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
ztrsm_((char *)"Right", (char *)"Upper", (char *)"No transpose", diag, &i__4, &jb, &z__1, ztrsm_((char *)"R", (char *)"U", (char *)"N", diag, &i__4, &jb, &z__1, &a[j + j * a_dim1], lda,
&a[j + j * a_dim1], lda, &a[j * a_dim1 + 1], lda, (ftnlen)5, (ftnlen)5, &a[j * a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)12, (ftnlen)1); ztrti2_((char *)"U", diag, &jb, &a[j + j * a_dim1], lda, info, (ftnlen)1, (ftnlen)1);
ztrti2_((char *)"Upper", diag, &jb, &a[j + j * a_dim1], lda, info, (ftnlen)5, (ftnlen)1);
} }
} else { } else {
nn = (*n - 1) / nb * nb + 1; nn = (*n - 1) / nb * nb + 1;
@ -92,16 +91,16 @@ int ztrtri_(char *uplo, char *diag, integer *n, doublecomplex *a, integer *lda,
jb = min(i__1, i__4); jb = min(i__1, i__4);
if (j + jb <= *n) { if (j + jb <= *n) {
i__1 = *n - j - jb + 1; i__1 = *n - j - jb + 1;
ztrmm_((char *)"Left", (char *)"Lower", (char *)"No transpose", diag, &i__1, &jb, &c_b1, ztrmm_((char *)"L", (char *)"L", (char *)"N", diag, &i__1, &jb, &c_b1, &a[j + jb + (j + jb) * a_dim1],
&a[j + jb + (j + jb) * a_dim1], lda, &a[j + jb + j * a_dim1], lda, lda, &a[j + jb + j * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)4, (ftnlen)5, (ftnlen)12, (ftnlen)1); (ftnlen)1);
i__1 = *n - j - jb + 1; i__1 = *n - j - jb + 1;
z__1.r = -1., z__1.i = -0.; z__1.r = -1., z__1.i = -0.;
ztrsm_((char *)"Right", (char *)"Lower", (char *)"No transpose", diag, &i__1, &jb, &z__1, ztrsm_((char *)"R", (char *)"L", (char *)"N", diag, &i__1, &jb, &z__1, &a[j + j * a_dim1], lda,
&a[j + j * a_dim1], lda, &a[j + jb + j * a_dim1], lda, (ftnlen)5, &a[j + jb + j * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)5, (ftnlen)12, (ftnlen)1); (ftnlen)1);
} }
ztrti2_((char *)"Lower", diag, &jb, &a[j + j * a_dim1], lda, info, (ftnlen)5, (ftnlen)1); ztrti2_((char *)"L", diag, &jb, &a[j + j * a_dim1], lda, info, (ftnlen)1, (ftnlen)1);
} }
} }
} }

10
lib/linalg/zung2l.cpp
View File

@ -10,9 +10,9 @@ int zung2l_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda,
doublecomplex z__1; doublecomplex z__1;
integer i__, j, l, ii; integer i__, j, l, ii;
extern int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), extern int zscal_(integer *, doublecomplex *, doublecomplex *, integer *),
zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, xerbla_(char *, integer *, ftnlen),
doublecomplex *, integer *, doublecomplex *, ftnlen), zlarf1l_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *,
xerbla_(char *, integer *, ftnlen); doublecomplex *, integer *, doublecomplex *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -53,8 +53,8 @@ int zung2l_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda,
a[i__2].r = 1., a[i__2].i = 0.; a[i__2].r = 1., a[i__2].i = 0.;
i__2 = *m - *n + ii; i__2 = *m - *n + ii;
i__3 = ii - 1; i__3 = ii - 1;
zlarf_((char *)"Left", &i__2, &i__3, &a[ii * a_dim1 + 1], &c__1, &tau[i__], &a[a_offset], lda, zlarf1l_((char *)"L", &i__2, &i__3, &a[ii * a_dim1 + 1], &c__1, &tau[i__], &a[a_offset], lda,
&work[1], (ftnlen)4); &work[1], (ftnlen)1);
i__2 = *m - *n + ii - 1; i__2 = *m - *n + ii - 1;
i__3 = i__; i__3 = i__;
z__1.r = -tau[i__3].r, z__1.i = -tau[i__3].i; z__1.r = -tau[i__3].r, z__1.i = -tau[i__3].i;

12
lib/linalg/zung2r.cpp
View File

@ -10,9 +10,9 @@ int zung2r_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda,
doublecomplex z__1; doublecomplex z__1;
integer i__, j, l; integer i__, j, l;
extern int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), extern int zscal_(integer *, doublecomplex *, doublecomplex *, integer *),
zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, xerbla_(char *, integer *, ftnlen),
doublecomplex *, integer *, doublecomplex *, ftnlen), zlarf1f_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *,
xerbla_(char *, integer *, ftnlen); doublecomplex *, integer *, doublecomplex *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -48,12 +48,10 @@ int zung2r_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda,
} }
for (i__ = *k; i__ >= 1; --i__) { for (i__ = *k; i__ >= 1; --i__) {
if (i__ < *n) { if (i__ < *n) {
i__1 = i__ + i__ * a_dim1;
a[i__1].r = 1., a[i__1].i = 0.;
i__1 = *m - i__ + 1; i__1 = *m - i__ + 1;
i__2 = *n - i__; i__2 = *n - i__;
zlarf_((char *)"Left", &i__1, &i__2, &a[i__ + i__ * a_dim1], &c__1, &tau[i__], zlarf1f_((char *)"L", &i__1, &i__2, &a[i__ + i__ * a_dim1], &c__1, &tau[i__],
&a[i__ + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)4); &a[i__ + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)1);
} }
if (i__ < *m) { if (i__ < *m) {
i__1 = *m - i__; i__1 = *m - i__;

12
lib/linalg/zungl2.cpp
View File

@ -10,9 +10,9 @@ int zungl2_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda,
void d_lmp_cnjg(doublecomplex *, doublecomplex *); void d_lmp_cnjg(doublecomplex *, doublecomplex *);
integer i__, j, l; integer i__, j, l;
extern int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), extern int zscal_(integer *, doublecomplex *, doublecomplex *, integer *),
zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, xerbla_(char *, integer *, ftnlen), zlacgv_(integer *, doublecomplex *, integer *),
doublecomplex *, integer *, doublecomplex *, ftnlen), zlarf1f_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *,
xerbla_(char *, integer *, ftnlen), zlacgv_(integer *, doublecomplex *, integer *); doublecomplex *, integer *, doublecomplex *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -55,13 +55,11 @@ int zungl2_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda,
i__1 = *n - i__; i__1 = *n - i__;
zlacgv_(&i__1, &a[i__ + (i__ + 1) * a_dim1], lda); zlacgv_(&i__1, &a[i__ + (i__ + 1) * a_dim1], lda);
if (i__ < *m) { if (i__ < *m) {
i__1 = i__ + i__ * a_dim1;
a[i__1].r = 1., a[i__1].i = 0.;
i__1 = *m - i__; i__1 = *m - i__;
i__2 = *n - i__ + 1; i__2 = *n - i__ + 1;
d_lmp_cnjg(&z__1, &tau[i__]); d_lmp_cnjg(&z__1, &tau[i__]);
zlarf_((char *)"Right", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda, &z__1, zlarf1f_((char *)"R", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda, &z__1,
&a[i__ + 1 + i__ * a_dim1], lda, &work[1], (ftnlen)5); &a[i__ + 1 + i__ * a_dim1], lda, &work[1], (ftnlen)1);
} }
i__1 = *n - i__; i__1 = *n - i__;
i__2 = i__; i__2 = i__;

10
lib/linalg/zungql.cpp
View File

@ -105,13 +105,13 @@ int zungql_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda,
ib = min(i__3, i__4); ib = min(i__3, i__4);
if (*n - *k + i__ > 1) { if (*n - *k + i__ > 1) {
i__3 = *m - *k + i__ + ib - 1; i__3 = *m - *k + i__ + ib - 1;
zlarft_((char *)"Backward", (char *)"Columnwise", &i__3, &ib, &a[(*n - *k + i__) * a_dim1 + 1], lda, zlarft_((char *)"B", (char *)"C", &i__3, &ib, &a[(*n - *k + i__) * a_dim1 + 1], lda, &tau[i__],
&tau[i__], &work[1], &ldwork, (ftnlen)8, (ftnlen)10); &work[1], &ldwork, (ftnlen)1, (ftnlen)1);
i__3 = *m - *k + i__ + ib - 1; i__3 = *m - *k + i__ + ib - 1;
i__4 = *n - *k + i__ - 1; i__4 = *n - *k + i__ - 1;
zlarfb_((char *)"Left", (char *)"No transpose", (char *)"Backward", (char *)"Columnwise", &i__3, &i__4, &ib, zlarfb_((char *)"L", (char *)"N", (char *)"B", (char *)"C", &i__3, &i__4, &ib, &a[(*n - *k + i__) * a_dim1 + 1],
&a[(*n - *k + i__) * a_dim1 + 1], lda, &work[1], &ldwork, &a[a_offset], lda, lda, &work[1], &ldwork, &a[a_offset], lda, &work[ib + 1], &ldwork,
&work[ib + 1], &ldwork, (ftnlen)4, (ftnlen)12, (ftnlen)8, (ftnlen)10); (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
} }
i__3 = *m - *k + i__ + ib - 1; i__3 = *m - *k + i__ + ib - 1;
zung2l_(&i__3, &ib, &ib, &a[(*n - *k + i__) * a_dim1 + 1], lda, &tau[i__], &work[1], zung2l_(&i__3, &ib, &ib, &a[(*n - *k + i__) * a_dim1 + 1], lda, &tau[i__], &work[1],

11
lib/linalg/zungqr.cpp
View File

@ -102,14 +102,13 @@ int zungqr_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda,
ib = min(i__2, i__3); ib = min(i__2, i__3);
if (i__ + ib <= *n) { if (i__ + ib <= *n) {
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
zlarft_((char *)"Forward", (char *)"Columnwise", &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], zlarft_((char *)"F", (char *)"C", &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1],
&work[1], &ldwork, (ftnlen)7, (ftnlen)10); &ldwork, (ftnlen)1, (ftnlen)1);
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
i__3 = *n - i__ - ib + 1; i__3 = *n - i__ - ib + 1;
zlarfb_((char *)"Left", (char *)"No transpose", (char *)"Forward", (char *)"Columnwise", &i__2, &i__3, &ib, zlarfb_((char *)"L", (char *)"N", (char *)"F", (char *)"C", &i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda,
&a[i__ + i__ * a_dim1], lda, &work[1], &ldwork, &work[1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &work[ib + 1],
&a[i__ + (i__ + ib) * a_dim1], lda, &work[ib + 1], &ldwork, (ftnlen)4, &ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
(ftnlen)12, (ftnlen)7, (ftnlen)10);
} }
i__2 = *m - i__ + 1; i__2 = *m - i__ + 1;
zung2r_(&i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo); zung2r_(&i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo);

15
lib/linalg/zunm2l.cpp
View File

@ -11,14 +11,13 @@ int zunm2l_(char *side, char *trans, integer *m, integer *n, integer *k, doublec
doublecomplex z__1; doublecomplex z__1;
void d_lmp_cnjg(doublecomplex *, doublecomplex *); void d_lmp_cnjg(doublecomplex *, doublecomplex *);
integer i__, i1, i2, i3, mi, ni, nq; integer i__, i1, i2, i3, mi, ni, nq;
doublecomplex aii;
logical left; logical left;
doublecomplex taui; doublecomplex taui;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, extern int xerbla_(char *, integer *, ftnlen);
doublecomplex *, integer *, doublecomplex *, ftnlen),
xerbla_(char *, integer *, ftnlen);
logical notran; logical notran;
extern int zlarf1l_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -87,14 +86,8 @@ int zunm2l_(char *side, char *trans, integer *m, integer *n, integer *k, doublec
d_lmp_cnjg(&z__1, &tau[i__]); d_lmp_cnjg(&z__1, &tau[i__]);
taui.r = z__1.r, taui.i = z__1.i; taui.r = z__1.r, taui.i = z__1.i;
} }
i__3 = nq - *k + i__ + i__ * a_dim1; zlarf1l_(side, &mi, &ni, &a[i__ * a_dim1 + 1], &c__1, &taui, &c__[c_offset], ldc, &work[1],
aii.r = a[i__3].r, aii.i = a[i__3].i;
i__3 = nq - *k + i__ + i__ * a_dim1;
a[i__3].r = 1., a[i__3].i = 0.;
zlarf_(side, &mi, &ni, &a[i__ * a_dim1 + 1], &c__1, &taui, &c__[c_offset], ldc, &work[1],
(ftnlen)1); (ftnlen)1);
i__3 = nq - *k + i__ + i__ * a_dim1;
a[i__3].r = aii.r, a[i__3].i = aii.i;
} }
return 0; return 0;
} }

15
lib/linalg/zunm2r.cpp
View File

@ -11,14 +11,13 @@ int zunm2r_(char *side, char *trans, integer *m, integer *n, integer *k, doublec
doublecomplex z__1; doublecomplex z__1;
void d_lmp_cnjg(doublecomplex *, doublecomplex *); void d_lmp_cnjg(doublecomplex *, doublecomplex *);
integer i__, i1, i2, i3, ic, jc, mi, ni, nq; integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
doublecomplex aii;
logical left; logical left;
doublecomplex taui; doublecomplex taui;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, extern int xerbla_(char *, integer *, ftnlen);
doublecomplex *, integer *, doublecomplex *, ftnlen),
xerbla_(char *, integer *, ftnlen);
logical notran; logical notran;
extern int zlarf1f_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, ftnlen);
a_dim1 = *lda; a_dim1 = *lda;
a_offset = 1 + a_dim1; a_offset = 1 + a_dim1;
a -= a_offset; a -= a_offset;
@ -91,14 +90,8 @@ int zunm2r_(char *side, char *trans, integer *m, integer *n, integer *k, doublec
d_lmp_cnjg(&z__1, &tau[i__]); d_lmp_cnjg(&z__1, &tau[i__]);
taui.r = z__1.r, taui.i = z__1.i; taui.r = z__1.r, taui.i = z__1.i;
} }
i__3 = i__ + i__ * a_dim1; zlarf1f_(side, &mi, &ni, &a[i__ + i__ * a_dim1], &c__1, &taui, &c__[ic + jc * c_dim1], ldc,
aii.r = a[i__3].r, aii.i = a[i__3].i;
i__3 = i__ + i__ * a_dim1;
a[i__3].r = 1., a[i__3].i = 0.;
zlarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], &c__1, &taui, &c__[ic + jc * c_dim1], ldc,
&work[1], (ftnlen)1); &work[1], (ftnlen)1);
i__3 = i__ + i__ * a_dim1;
a[i__3].r = aii.r, a[i__3].i = aii.i;
} }
return 0; return 0;
} }

10
lib/linalg/zunmql.cpp
View File

@ -129,16 +129,16 @@ int zunmql_(char *side, char *trans, integer *m, integer *n, integer *k, doublec
i__4 = nb, i__5 = *k - i__ + 1; i__4 = nb, i__5 = *k - i__ + 1;
ib = min(i__4, i__5); ib = min(i__4, i__5);
i__4 = nq - *k + i__ + ib - 1; i__4 = nq - *k + i__ + ib - 1;
zlarft_((char *)"Backward", (char *)"Columnwise", &i__4, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], zlarft_((char *)"B", (char *)"C", &i__4, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], &work[iwt], &c__65,
&work[iwt], &c__65, (ftnlen)8, (ftnlen)10); (ftnlen)1, (ftnlen)1);
if (left) { if (left) {
mi = *m - *k + i__ + ib - 1; mi = *m - *k + i__ + ib - 1;
} else { } else {
ni = *n - *k + i__ + ib - 1; ni = *n - *k + i__ + ib - 1;
} }
zlarfb_(side, trans, (char *)"Backward", (char *)"Columnwise", &mi, &ni, &ib, &a[i__ * a_dim1 + 1], lda, zlarfb_(side, trans, (char *)"B", (char *)"C", &mi, &ni, &ib, &a[i__ * a_dim1 + 1], lda, &work[iwt],
&work[iwt], &c__65, &c__[c_offset], ldc, &work[1], &ldwork, (ftnlen)1, &c__65, &c__[c_offset], ldc, &work[1], &ldwork, (ftnlen)1, (ftnlen)1, (ftnlen)1,
(ftnlen)1, (ftnlen)8, (ftnlen)10); (ftnlen)1);
} }
} }
work[1].r = (doublereal)lwkopt, work[1].i = 0.; work[1].r = (doublereal)lwkopt, work[1].i = 0.;

10
lib/linalg/zunmqr.cpp
View File

@ -128,8 +128,8 @@ int zunmqr_(char *side, char *trans, integer *m, integer *n, integer *k, doublec
i__4 = nb, i__5 = *k - i__ + 1; i__4 = nb, i__5 = *k - i__ + 1;
ib = min(i__4, i__5); ib = min(i__4, i__5);
i__4 = nq - i__ + 1; i__4 = nq - i__ + 1;
zlarft_((char *)"Forward", (char *)"Columnwise", &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], zlarft_((char *)"F", (char *)"C", &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[iwt],
&work[iwt], &c__65, (ftnlen)7, (ftnlen)10); &c__65, (ftnlen)1, (ftnlen)1);
if (left) { if (left) {
mi = *m - i__ + 1; mi = *m - i__ + 1;
ic = i__; ic = i__;
@ -137,9 +137,9 @@ int zunmqr_(char *side, char *trans, integer *m, integer *n, integer *k, doublec
ni = *n - i__ + 1; ni = *n - i__ + 1;
jc = i__; jc = i__;
} }
zlarfb_(side, trans, (char *)"Forward", (char *)"Columnwise", &mi, &ni, &ib, &a[i__ + i__ * a_dim1], zlarfb_(side, trans, (char *)"F", (char *)"C", &mi, &ni, &ib, &a[i__ + i__ * a_dim1], lda, &work[iwt],
lda, &work[iwt], &c__65, &c__[ic + jc * c_dim1], ldc, &work[1], &ldwork, &c__65, &c__[ic + jc * c_dim1], ldc, &work[1], &ldwork, (ftnlen)1, (ftnlen)1,
(ftnlen)1, (ftnlen)1, (ftnlen)7, (ftnlen)10); (ftnlen)1, (ftnlen)1);
} }
} }
work[1].r = (doublereal)lwkopt, work[1].i = 0.; work[1].r = (doublereal)lwkopt, work[1].i = 0.;