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

update to LAPACK 3.12

Browse Source
This commit is contained in:
Axel Kohlmeyer
2023-11-24 15:29:14 -05:00
parent 33dcfb5390
commit 2a1af662d4
15 changed files with 109 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
lib/linalg/dlaed3.cpp
View File

@ -3,10 +3,10 @@ extern "C" {
#endif
#include "lmp_f2c.h"
static integer c__1 = 1;
static doublereal c_b22 = 1.;
static doublereal c_b23 = 0.;
static doublereal c_b21 = 1.;
static doublereal c_b22 = 0.;
int dlaed3_(integer *k, integer *n, integer *n1, doublereal *d__, doublereal *q, integer *ldq,
doublereal *rho, doublereal *dlamda, doublereal *q2, integer *indx, integer *ctot,
doublereal *rho, doublereal *dlambda, doublereal *q2, integer *indx, integer *ctot,
doublereal *w, doublereal *s, integer *info)
{
integer q_dim1, q_offset, i__1, i__2;
@ -20,10 +20,9 @@ int dlaed3_(integer *k, integer *n, integer *n1, doublereal *d__, doublereal *q,
ftnlen, ftnlen),
dcopy_(integer *, doublereal *, integer *, doublereal *, integer *),
dlaed4_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *);
extern doublereal dlamc3_(doublereal *, doublereal *);
extern int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
integer *, ftnlen),
doublereal *, integer *),
dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
ftnlen),
dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *,
ftnlen),
xerbla_(char *, integer *, ftnlen);
@ -31,7 +30,7 @@ int dlaed3_(integer *k, integer *n, integer *n1, doublereal *d__, doublereal *q,
q_dim1 = *ldq;
q_offset = 1 + q_dim1;
q -= q_offset;
--dlamda;
--dlambda;
--q2;
--indx;
--ctot;
@ -54,12 +53,8 @@ int dlaed3_(integer *k, integer *n, integer *n1, doublereal *d__, doublereal *q,
return 0;
}
i__1 = *k;
for (i__ = 1; i__ <= i__1; ++i__) {
dlamda[i__] = dlamc3_(&dlamda[i__], &dlamda[i__]) - dlamda[i__];
}
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
dlaed4_(k, &j, &dlamda[1], &w[1], &q[j * q_dim1 + 1], rho, &d__[j], info);
dlaed4_(k, &j, &dlambda[1], &w[1], &q[j * q_dim1 + 1], rho, &d__[j], info);
if (*info != 0) {
goto L120;
}
@ -86,11 +81,11 @@ int dlaed3_(integer *k, integer *n, integer *n1, doublereal *d__, doublereal *q,
for (j = 1; j <= i__1; ++j) {
i__2 = j - 1;
for (i__ = 1; i__ <= i__2; ++i__) {
w[i__] *= q[i__ + j * q_dim1] / (dlamda[i__] - dlamda[j]);
w[i__] *= q[i__ + j * q_dim1] / (dlambda[i__] - dlambda[j]);
}
i__2 = *k;
for (i__ = j + 1; i__ <= i__2; ++i__) {
w[i__] *= q[i__ + j * q_dim1] / (dlamda[i__] - dlamda[j]);
w[i__] *= q[i__ + j * q_dim1] / (dlambda[i__] - dlambda[j]);
}
}
i__1 = *k;
@ -118,17 +113,17 @@ L110:
dlacpy_((char *)"A", &n23, k, &q[ctot[1] + 1 + q_dim1], ldq, &s[1], &n23, (ftnlen)1);
iq2 = *n1 * n12 + 1;
if (n23 != 0) {
dgemm_((char *)"N", (char *)"N", &n2, k, &n23, &c_b22, &q2[iq2], &n2, &s[1], &n23, &c_b23,
dgemm_((char *)"N", (char *)"N", &n2, k, &n23, &c_b21, &q2[iq2], &n2, &s[1], &n23, &c_b22,
&q[*n1 + 1 + q_dim1], ldq, (ftnlen)1, (ftnlen)1);
} else {
dlaset_((char *)"A", &n2, k, &c_b23, &c_b23, &q[*n1 + 1 + q_dim1], ldq, (ftnlen)1);
dlaset_((char *)"A", &n2, k, &c_b22, &c_b22, &q[*n1 + 1 + q_dim1], ldq, (ftnlen)1);
}
dlacpy_((char *)"A", &n12, k, &q[q_offset], ldq, &s[1], &n12, (ftnlen)1);
if (n12 != 0) {
dgemm_((char *)"N", (char *)"N", n1, k, &n12, &c_b22, &q2[1], n1, &s[1], &n12, &c_b23, &q[q_offset], ldq,
dgemm_((char *)"N", (char *)"N", n1, k, &n12, &c_b21, &q2[1], n1, &s[1], &n12, &c_b22, &q[q_offset], ldq,
(ftnlen)1, (ftnlen)1);
} else {
dlaset_((char *)"A", n1, k, &c_b23, &c_b23, &q[q_dim1 + 1], ldq, (ftnlen)1);
dlaset_((char *)"A", n1, k, &c_b22, &c_b22, &q[q_dim1 + 1], ldq, (ftnlen)1);
}
L120:
return 0;