#ifdef __cplusplus extern "C" { #endif #include "lmp_f2c.h" static doublereal c_b4 = -1.; static doublereal c_b5 = 1.; static integer c__1 = 1; static doublereal c_b38 = 0.; int dlahr2_(integer *n, integer *k, integer *nb, doublereal *a, integer *lda, doublereal *tau, doublereal *t, integer *ldt, doublereal *y, integer *ldy) { integer a_dim1, a_offset, t_dim1, t_offset, y_dim1, y_offset, i__1, i__2, i__3; doublereal d__1; integer i__; doublereal ei; extern int dscal_(integer *, doublereal *, doublereal *, integer *), dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen, ftnlen), dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, ftnlen, ftnlen, ftnlen, ftnlen), daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *, ftnlen, ftnlen, ftnlen), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, ftnlen); --tau; a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; t_dim1 = *ldt; t_offset = 1 + t_dim1; t -= t_offset; y_dim1 = *ldy; y_offset = 1 + y_dim1; y -= y_offset; if (*n <= 1) { return 0; } i__1 = *nb; for (i__ = 1; i__ <= i__1; ++i__) { 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); 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); 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_b5, &t[*nb * t_dim1 + 1], &c__1, (ftnlen)9); 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); 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); 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); 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; } i__2 = *n - *k - i__ + 1; i__3 = *k + i__ + 1; dlarfg_(&i__2, &a[*k + i__ + i__ * a_dim1], &a[min(i__3, *n) + i__ * a_dim1], &c__1, &tau[i__]); ei = a[*k + i__ + i__ * a_dim1]; 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, &a[*k + i__ + i__ * a_dim1], &c__1, &c_b38, &y[*k + 1 + i__ * y_dim1], &c__1, (ftnlen)12); 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); 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); 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); 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); 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); } 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); return 0; } #ifdef __cplusplus } #endif