2 #include "gromacs/utility/real.h"
4 #include "../gmx_blas.h"
5 #include "../gmx_lapack.h"
8 F77_FUNC(slarft,SLARFT)(const char *direct,
18 /* System generated locals */
19 int t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3;
29 v_offset = 1 + v_dim1;
33 t_offset = 1 + t_dim1;
40 if (*direct=='F' || *direct=='f') {
42 for (i__ = 1; i__ <= i__1; ++i__) {
43 if (fabs(tau[i__])<GMX_FLOAT_MIN) {
46 for (j = 1; j <= i__2; ++j) {
47 t[j + i__ * t_dim1] = 0.;
51 vii = v[i__ + i__ * v_dim1];
52 v[i__ + i__ * v_dim1] = 1.;
53 if (*storev=='C' || *storev=='c') {
58 F77_FUNC(sgemv,SGEMV)("Transpose", &i__2, &i__3, &d__1, &v[i__ + v_dim1],
59 ldv, &v[i__ + i__ * v_dim1], &c__1, &zero, &t[
60 i__ * t_dim1 + 1], &c__1);
66 F77_FUNC(sgemv,SGEMV)("No transpose", &i__2, &i__3, &d__1, &v[i__ *
67 v_dim1 + 1], ldv, &v[i__ + i__ * v_dim1], ldv, &
68 zero, &t[i__ * t_dim1 + 1], &c__1);
70 v[i__ + i__ * v_dim1] = vii;
74 F77_FUNC(strmv,STRMV)("Upper", "No transpose", "Non-unit", &i__2, &t[
75 t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1);
76 t[i__ + i__ * t_dim1] = tau[i__];
80 for (i__ = *k; i__ >= 1; --i__) {
81 if (fabs(tau[i__])<GMX_FLOAT_MIN) {
84 for (j = i__; j <= i__1; ++j) {
85 t[j + i__ * t_dim1] = 0.;
90 if (*storev=='C' || *storev=='c') {
91 vii = v[*n - *k + i__ + i__ * v_dim1];
92 v[*n - *k + i__ + i__ * v_dim1] = 1.;
97 F77_FUNC(sgemv,SGEMV)("Transpose", &i__1, &i__2, &d__1, &v[(i__ + 1)
98 * v_dim1 + 1], ldv, &v[i__ * v_dim1 + 1], &
99 c__1, &zero, &t[i__ + 1 + i__ * t_dim1], &
101 v[*n - *k + i__ + i__ * v_dim1] = vii;
103 vii = v[i__ + (*n - *k + i__) * v_dim1];
104 v[i__ + (*n - *k + i__) * v_dim1] = 1.;
107 i__2 = *n - *k + i__;
109 F77_FUNC(sgemv,SGEMV)("No transpose", &i__1, &i__2, &d__1, &v[i__ +
110 1 + v_dim1], ldv, &v[i__ + v_dim1], ldv, &
111 zero, &t[i__ + 1 + i__ * t_dim1], &c__1);
112 v[i__ + (*n - *k + i__) * v_dim1] = vii;
116 F77_FUNC(strmv,STRMV)("Lower", "No transpose", "Non-unit", &i__1, &t[i__
117 + 1 + (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ *
121 t[i__ + i__ * t_dim1] = tau[i__];