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

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,
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;
double sqrt(doublereal);
integer j, k;
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;
extern int dscal_(integer *, doublereal *, doublereal *, integer *),
dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen,
ftnlen);
extern int dscal_(integer *, doublereal *, doublereal *, integer *);
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *,
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;
extern integer idamax_(integer *, doublereal *, integer *);
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_offset = 1 + a_dim1;
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);
if (k < *n) {
i__1 = *n - k;
dgemv_((char *)"No transpose", &k, &i__1, &c_b8, &a[(k + 1) * a_dim1 + 1], lda,
&w[k + (kw + 1) * w_dim1], ldw, &c_b9, &w[kw * w_dim1 + 1], &c__1, (ftnlen)12);
dgemv_((char *)"N", &k, &i__1, &c_b8, &a[(k + 1) * a_dim1 + 1], lda, &w[k + (kw + 1) * w_dim1],
ldw, &c_b9, &w[kw * w_dim1 + 1], &c__1, (ftnlen)1);
}
kstep = 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);
if (k < *n) {
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],
&c__1, (ftnlen)12);
&c__1, (ftnlen)1);
}
i__1 = k - imax;
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;
goto L10;
L30:
i__1 = -(*nb);
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;
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);
}
i__1 = *n - k;
dgemmtr_((char *)"U", (char *)"N", (char *)"T", &k, &i__1, &c_b8, &a[(k + 1) * a_dim1 + 1], lda,
&w[(kw + 1) * w_dim1 + 1], ldw, &c_b9, &a[a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1,
(ftnlen)1);
j = k + 1;
L60:
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);
i__1 = *n - 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,
&w[k + k * w_dim1], &c__1, (ftnlen)12);
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)1);
kstep = 1;
absakk = (d__1 = w[k + k * w_dim1], abs(d__1));
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);
i__1 = *n - 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],
ldw, &c_b9, &w[k + (k + 1) * w_dim1], &c__1, (ftnlen)12);
dgemv_((char *)"N", &i__1, &i__2, &c_b8, &a[k + a_dim1], lda, &w[imax + w_dim1], ldw, &c_b9,
&w[k + (k + 1) * w_dim1], &c__1, (ftnlen)1);
i__1 = imax - k;
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));
@ -293,26 +279,10 @@ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, int
k += kstep;
goto L70;
L90:
i__1 = *n;
i__2 = *nb;
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;
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);
}
}
i__1 = *n - k + 1;
i__2 = k - 1;
dgemmtr_((char *)"L", (char *)"N", (char *)"T", &i__1, &i__2, &c_b8, &a[k + a_dim1], lda, &w[k + w_dim1], ldw,
&c_b9, &a[k + k * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1);
j = k - 1;
L120:
jj = j;