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

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) {
i__2 = *n - *k;
i__3 = i__ - 1;
dgemv_((char *)"NO TRANSPOSE", &i__2, &i__3, &c_b4, &y[*k + 1 + y_dim1], ldy,
&a[*k + i__ - 1 + a_dim1], lda, &c_b5, &a[*k + 1 + i__ * a_dim1], &c__1,
(ftnlen)12);
dgemv_((char *)"T", &i__2, &i__3, &c_b4, &y[*k + 1 + y_dim1], ldy, &a[*k + i__ - 1 + a_dim1],
lda, &c_b5, &a[*k + 1 + i__ * a_dim1], &c__1, (ftnlen)1);
i__2 = i__ - 1;
dcopy_(&i__2, &a[*k + 1 + i__ * a_dim1], &c__1, &t[*nb * t_dim1 + 1], &c__1);
i__2 = i__ - 1;
dtrmv_((char *)"Lower", (char *)"Transpose", (char *)"UNIT", &i__2, &a[*k + 1 + a_dim1], lda,
&t[*nb * t_dim1 + 1], &c__1, (ftnlen)5, (ftnlen)9, (ftnlen)4);
dtrmv_((char *)"L", (char *)"T", (char *)"U", &i__2, &a[*k + 1 + a_dim1], lda, &t[*nb * t_dim1 + 1], &c__1,
(ftnlen)1, (ftnlen)1, (ftnlen)1);
i__2 = *n - *k - 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,
(ftnlen)9);
(ftnlen)1);
i__2 = i__ - 1;
dtrmv_((char *)"Upper", (char *)"Transpose", (char *)"NON-UNIT", &i__2, &t[t_offset], ldt, &t[*nb * t_dim1 + 1],
&c__1, (ftnlen)5, (ftnlen)9, (ftnlen)8);
dtrmv_((char *)"U", (char *)"T", (char *)"N", &i__2, &t[t_offset], ldt, &t[*nb * t_dim1 + 1], &c__1, (ftnlen)1,
(ftnlen)1, (ftnlen)1);
i__2 = *n - *k - i__ + 1;
i__3 = i__ - 1;
dgemv_((char *)"NO TRANSPOSE", &i__2, &i__3, &c_b4, &a[*k + i__ + a_dim1], lda,
&t[*nb * t_dim1 + 1], &c__1, &c_b5, &a[*k + i__ + i__ * a_dim1], &c__1,
(ftnlen)12);
dgemv_((char *)"T", &i__2, &i__3, &c_b4, &a[*k + i__ + a_dim1], lda, &t[*nb * t_dim1 + 1],
&c__1, &c_b5, &a[*k + i__ + i__ * a_dim1], &c__1, (ftnlen)1);
i__2 = i__ - 1;
dtrmv_((char *)"Lower", (char *)"NO TRANSPOSE", (char *)"UNIT", &i__2, &a[*k + 1 + a_dim1], lda,
&t[*nb * t_dim1 + 1], &c__1, (ftnlen)5, (ftnlen)12, (ftnlen)4);
dtrmv_((char *)"L", (char *)"T", (char *)"U", &i__2, &a[*k + 1 + a_dim1], lda, &t[*nb * t_dim1 + 1], &c__1,
(ftnlen)1, (ftnlen)1, (ftnlen)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);
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.;
i__2 = *n - *k;
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,
(ftnlen)12);
(ftnlen)1);
i__2 = *n - *k - i__ + 1;
i__3 = i__ - 1;
dgemv_((char *)"Transpose", &i__2, &i__3, &c_b5, &a[*k + i__ + a_dim1], lda,
&a[*k + i__ + i__ * a_dim1], &c__1, &c_b38, &t[i__ * t_dim1 + 1], &c__1, (ftnlen)9);
dgemv_((char *)"T", &i__2, &i__3, &c_b5, &a[*k + i__ + a_dim1], lda, &a[*k + i__ + i__ * a_dim1],
&c__1, &c_b38, &t[i__ * t_dim1 + 1], &c__1, (ftnlen)1);
i__2 = *n - *k;
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],
&c__1, &c_b5, &y[*k + 1 + i__ * y_dim1], &c__1, (ftnlen)12);
dgemv_((char *)"T", &i__2, &i__3, &c_b4, &y[*k + 1 + y_dim1], ldy, &t[i__ * t_dim1 + 1], &c__1,
&c_b5, &y[*k + 1 + i__ * y_dim1], &c__1, (ftnlen)1);
i__2 = *n - *k;
dscal_(&i__2, &tau[i__], &y[*k + 1 + i__ * y_dim1], &c__1);
i__2 = i__ - 1;
d__1 = -tau[i__];
dscal_(&i__2, &d__1, &t[i__ * t_dim1 + 1], &c__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],
&c__1, (ftnlen)5, (ftnlen)12, (ftnlen)8);
dtrmv_((char *)"U", (char *)"N", (char *)"N", &i__2, &t[t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1, (ftnlen)1,
(ftnlen)1, (ftnlen)1);
t[i__ + i__ * t_dim1] = tau[i__];
}
a[*k + *nb + *nb * a_dim1] = ei;
dlacpy_((char *)"ALL", k, nb, &a[(a_dim1 << 1) + 1], lda, &y[y_offset], ldy, (ftnlen)3);
dtrmm_((char *)"RIGHT", (char *)"Lower", (char *)"NO TRANSPOSE", (char *)"UNIT", k, nb, &c_b5, &a[*k + 1 + a_dim1], lda,
&y[y_offset], ldy, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4);
dlacpy_((char *)"A", k, nb, &a[(a_dim1 << 1) + 1], lda, &y[y_offset], ldy, (ftnlen)1);
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,
(ftnlen)1, (ftnlen)1, (ftnlen)1);
if (*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,
&a[*k + 1 + *nb + a_dim1], lda, &c_b5, &y[y_offset], ldy, (ftnlen)12, (ftnlen)12);
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)1, (ftnlen)1);
}
dtrmm_((char *)"RIGHT", (char *)"Upper", (char *)"NO TRANSPOSE", (char *)"NON-UNIT", k, nb, &c_b5, &t[t_offset], ldt,
&y[y_offset], ldy, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)8);
dtrmm_((char *)"R", (char *)"U", (char *)"T", (char *)"N", k, nb, &c_b5, &t[t_offset], ldt, &y[y_offset], ldy, (ftnlen)1,
(ftnlen)1, (ftnlen)1, (ftnlen)1);
return 0;
}
#ifdef __cplusplus