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

80
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,
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;
doublecomplex z__1, z__2, z__3;
double sqrt(doublereal), d_lmp_imag(doublecomplex *);
void z_lmp_div(doublecomplex *, doublecomplex *, doublecomplex *);
integer j, k;
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;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern int zscal_(integer *, doublecomplex *, doublecomplex *, integer *),
zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *,
integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *,
ftnlen, ftnlen);
extern int zscal_(integer *, doublecomplex *, doublecomplex *, integer *);
integer kstep;
extern int zgemv_(char *, integer *, 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;
extern integer izamax_(integer *, doublecomplex *, integer *);
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_offset = 1 + a_dim1;
a -= a_offset;
@ -50,8 +50,8 @@ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
if (k < *n) {
i__1 = *n - k;
z__1.r = -1., z__1.i = -0.;
zgemv_((char *)"No transpose", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda,
&w[k + (kw + 1) * w_dim1], ldw, &c_b1, &w[kw * w_dim1 + 1], &c__1, (ftnlen)12);
zgemv_((char *)"N", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda, &w[k + (kw + 1) * w_dim1],
ldw, &c_b1, &w[kw * w_dim1 + 1], &c__1, (ftnlen)1);
}
kstep = 1;
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) {
i__1 = *n - k;
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],
&c__1, (ftnlen)12);
&c__1, (ftnlen)1);
}
i__1 = k - imax;
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;
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;
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,
&w[jj + (kw + 1) * w_dim1], ldw, &c_b1, &a[j + jj * a_dim1], &c__1,
(ftnlen)12);
}
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);
}
i__1 = *n - k;
z__1.r = -1., z__1.i = -0.;
zgemmtr_((char *)"U", (char *)"N", (char *)"T", &k, &i__1, &z__1, &a[(k + 1) * a_dim1 + 1], lda,
&w[(kw + 1) * w_dim1 + 1], ldw, &c_b1, &a[a_dim1 + 1], lda, (ftnlen)1, (ftnlen)1,
(ftnlen)1);
j = k + 1;
L60:
jj = j;
@ -242,8 +227,8 @@ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
i__1 = *n - k + 1;
i__2 = k - 1;
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,
&w[k + k * w_dim1], &c__1, (ftnlen)12);
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)1);
kstep = 1;
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));
@ -272,8 +257,8 @@ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a,
i__1 = *n - k + 1;
i__2 = k - 1;
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],
ldw, &c_b1, &w[k + (k + 1) * w_dim1], &c__1, (ftnlen)12);
zgemv_((char *)"N", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[imax + w_dim1], ldw, &c_b1,
&w[k + (k + 1) * w_dim1], &c__1, (ftnlen)1);
i__1 = imax - k;
jmax = k - 1 + izamax_(&i__1, &w[k + (k + 1) * w_dim1], &c__1);
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;
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;
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],
ldw, &c_b1, &a[jj + jj * a_dim1], &c__1, (ftnlen)12);
}
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);
}
}
i__1 = *n - k + 1;
i__2 = k - 1;
z__1.r = -1., z__1.i = -0.;
zgemmtr_((char *)"L", (char *)"N", (char *)"T", &i__1, &i__2, &z__1, &a[k + a_dim1], lda, &w[k + w_dim1], ldw,
&c_b1, &a[k + k * a_dim1], lda, (ftnlen)1, (ftnlen)1, (ftnlen)1);
j = k - 1;
L120:
jj = j;