2 #include "gmx_lapack.h"
6 F77_FUNC(slarfb,SLARFB)(const char *side,
22 int c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1,
23 work_offset, i__1, i__2;
29 float minusone = -1.0;
32 v_offset = 1 + v_dim1;
35 t_offset = 1 + t_dim1;
38 c_offset = 1 + c_dim1;
41 work_offset = 1 + work_dim1;
44 if (*m <= 0 || *n <= 0) {
47 if (*trans=='N' || *trans=='n') {
48 *(unsigned char *)transt = 'T';
50 *(unsigned char *)transt = 'N';
53 if (*storev=='C' || *storev=='c') {
55 if (*direct=='F' || *direct=='f') {
56 if (*side=='l' || *side=='L') {
59 for (j = 1; j <= i__1; ++j) {
60 F77_FUNC(scopy,SCOPY)(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
64 F77_FUNC(strmm,STRMM)("Right", "Lower", "No transpose", "Unit", n, k, &one,
65 &v[v_offset], ldv, &work[work_offset], ldwork);
69 F77_FUNC(sgemm,SGEMM)("Transpose", "No transpose", n, k, &i__1, &one, &
70 c__[*k + 1 + c_dim1], ldc, &v[*k + 1 + v_dim1],
71 ldv, &one, &work[work_offset], ldwork);
74 F77_FUNC(strmm,STRMM)("Right", "Upper", transt, "Non-unit", n, k, &one, &t[
75 t_offset], ldt, &work[work_offset], ldwork);
79 F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", &i__1, n, k, &minusone, &
80 v[*k + 1 + v_dim1], ldv, &work[work_offset],
81 ldwork, &one, &c__[*k + 1 + c_dim1], ldc);
84 F77_FUNC(strmm,STRMM)("Right", "Lower", "Transpose", "Unit", n, k, &one, &
85 v[v_offset], ldv, &work[work_offset], ldwork);
88 for (j = 1; j <= i__1; ++j) {
90 for (i__ = 1; i__ <= i__2; ++i__) {
91 c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
95 } else if (*side=='r' || *side=='R') {
98 for (j = 1; j <= i__1; ++j) {
99 F77_FUNC(scopy,SCOPY)(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
100 work_dim1 + 1], &c__1);
103 F77_FUNC(strmm,STRMM)("Right", "Lower", "No transpose", "Unit", m, k, &one,
104 &v[v_offset], ldv, &work[work_offset], ldwork);
108 F77_FUNC(sgemm,SGEMM)("No transpose", "No transpose", m, k, &i__1, &
109 one, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k +
110 1 + v_dim1], ldv, &one, &work[work_offset],
114 F77_FUNC(strmm,STRMM)("Right", "Upper", trans, "Non-unit", m, k, &one, &t[
115 t_offset], ldt, &work[work_offset], ldwork);
119 F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", m, &i__1, k, &minusone, &
120 work[work_offset], ldwork, &v[*k + 1 + v_dim1],
121 ldv, &one, &c__[(*k + 1) * c_dim1 + 1], ldc);
124 F77_FUNC(strmm,STRMM)("Right", "Lower", "Transpose", "Unit", m, k, &one, &
125 v[v_offset], ldv, &work[work_offset], ldwork);
128 for (j = 1; j <= i__1; ++j) {
130 for (i__ = 1; i__ <= i__2; ++i__) {
131 c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
138 if (*side=='l' || *side=='L') {
140 for (j = 1; j <= i__1; ++j) {
141 F77_FUNC(scopy,SCOPY)(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
142 work_dim1 + 1], &c__1);
145 F77_FUNC(strmm,STRMM)("Right", "Upper", "No transpose", "Unit", n, k, &one,
146 &v[*m - *k + 1 + v_dim1], ldv, &work[work_offset],
150 F77_FUNC(sgemm,SGEMM)("Transpose", "No transpose", n, k, &i__1, &one, &
151 c__[c_offset], ldc, &v[v_offset], ldv, &one, &
152 work[work_offset], ldwork);
155 F77_FUNC(strmm,STRMM)("Right", "Lower", transt, "Non-unit", n, k, &one, &t[
156 t_offset], ldt, &work[work_offset], ldwork);
161 F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", &i__1, n, k, &minusone, &
162 v[v_offset], ldv, &work[work_offset], ldwork, &
163 one, &c__[c_offset], ldc)
167 F77_FUNC(strmm,STRMM)("Right", "Upper", "Transpose", "Unit", n, k, &one, &
168 v[*m - *k + 1 + v_dim1], ldv, &work[work_offset],
172 for (j = 1; j <= i__1; ++j) {
174 for (i__ = 1; i__ <= i__2; ++i__) {
175 c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j *
180 } else if (*side=='r' || *side=='R') {
182 for (j = 1; j <= i__1; ++j) {
183 F77_FUNC(scopy,SCOPY)(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
184 j * work_dim1 + 1], &c__1);
187 F77_FUNC(strmm,STRMM)("Right", "Upper", "No transpose", "Unit", m, k, &one,
188 &v[*n - *k + 1 + v_dim1], ldv, &work[work_offset],
192 F77_FUNC(sgemm,SGEMM)("No transpose", "No transpose", m, k, &i__1, &
193 one, &c__[c_offset], ldc, &v[v_offset], ldv, &
194 one, &work[work_offset], ldwork);
196 F77_FUNC(strmm,STRMM)("Right", "Lower", trans, "Non-unit", m, k, &one, &t[
197 t_offset], ldt, &work[work_offset], ldwork);
200 F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", m, &i__1, k, &minusone, &
201 work[work_offset], ldwork, &v[v_offset], ldv, &
202 one, &c__[c_offset], ldc)
205 F77_FUNC(strmm,STRMM)("Right", "Upper", "Transpose", "Unit", m, k, &one, &
206 v[*n - *k + 1 + v_dim1], ldv, &work[work_offset],
209 for (j = 1; j <= i__1; ++j) {
211 for (i__ = 1; i__ <= i__2; ++i__) {
212 c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j *
219 } else if (*storev=='r' || *storev=='R') {
220 if (*direct=='F' || *direct=='f') {
221 if (*side=='l' || *side=='L') {
223 for (j = 1; j <= i__1; ++j) {
224 F77_FUNC(scopy,SCOPY)(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
227 F77_FUNC(strmm,STRMM)("Right", "Upper", "Transpose", "Unit", n, k, &one, &
228 v[v_offset], ldv, &work[work_offset], ldwork);
231 F77_FUNC(sgemm,SGEMM)("Transpose", "Transpose", n, k, &i__1, &one, &
232 c__[*k + 1 + c_dim1], ldc, &v[(*k + 1) * v_dim1 +
233 1], ldv, &one, &work[work_offset], ldwork);
236 F77_FUNC(strmm,STRMM)("Right", "Upper", transt, "Non-unit", n, k, &one, &t[
237 t_offset], ldt, &work[work_offset], ldwork);
241 F77_FUNC(sgemm,SGEMM)("Transpose", "Transpose", &i__1, n, k, &minusone, &v[(
242 *k + 1) * v_dim1 + 1], ldv, &work[work_offset],
243 ldwork, &one, &c__[*k + 1 + c_dim1], ldc);
246 F77_FUNC(strmm,STRMM)("Right", "Upper", "No transpose", "Unit", n, k, &one,
247 &v[v_offset], ldv, &work[work_offset], ldwork);
250 for (j = 1; j <= i__1; ++j) {
252 for (i__ = 1; i__ <= i__2; ++i__) {
253 c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
257 } else if (*side=='r' || *side=='R') {
260 for (j = 1; j <= i__1; ++j) {
261 F77_FUNC(scopy,SCOPY)(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
262 work_dim1 + 1], &c__1);
265 F77_FUNC(strmm,STRMM)("Right", "Upper", "Transpose", "Unit", m, k, &one, &
266 v[v_offset], ldv, &work[work_offset], ldwork);
270 F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", m, k, &i__1, &one, &
271 c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k + 1) *
272 v_dim1 + 1], ldv, &one, &work[work_offset],
276 F77_FUNC(strmm,STRMM)("Right", "Upper", trans, "Non-unit", m, k, &one, &t[
277 t_offset], ldt, &work[work_offset], ldwork);
282 F77_FUNC(sgemm,SGEMM)("No transpose", "No transpose", m, &i__1, k, &
283 minusone, &work[work_offset], ldwork, &v[(*k + 1) *
284 v_dim1 + 1], ldv, &one, &c__[(*k + 1) * c_dim1
287 F77_FUNC(strmm,STRMM)("Right", "Upper", "No transpose", "Unit", m, k, &one,
288 &v[v_offset], ldv, &work[work_offset], ldwork);
290 for (j = 1; j <= i__1; ++j) {
292 for (i__ = 1; i__ <= i__2; ++i__) {
293 c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
301 if (*side=='l' || *side=='L') {
304 for (j = 1; j <= i__1; ++j) {
305 F77_FUNC(scopy,SCOPY)(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
306 work_dim1 + 1], &c__1);
309 F77_FUNC(strmm,STRMM)("Right", "Lower", "Transpose", "Unit", n, k, &one, &
310 v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[work_offset]
315 F77_FUNC(sgemm,SGEMM)("Transpose", "Transpose", n, k, &i__1, &one, &
316 c__[c_offset], ldc, &v[v_offset], ldv, &one, &
317 work[work_offset], ldwork);
320 F77_FUNC(strmm,STRMM)("Right", "Lower", transt, "Non-unit", n, k, &one, &t[
321 t_offset], ldt, &work[work_offset], ldwork);
326 F77_FUNC(sgemm,SGEMM)("Transpose", "Transpose", &i__1, n, k, &minusone, &v[
327 v_offset], ldv, &work[work_offset], ldwork, &
328 one, &c__[c_offset], ldc);
331 F77_FUNC(strmm,STRMM)("Right", "Lower", "No transpose", "Unit", n, k, &one,
332 &v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[
333 work_offset], ldwork);
336 for (j = 1; j <= i__1; ++j) {
338 for (i__ = 1; i__ <= i__2; ++i__) {
339 c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j *
344 } else if (*side=='r' || *side=='R') {
347 for (j = 1; j <= i__1; ++j) {
348 F77_FUNC(scopy,SCOPY)(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
349 j * work_dim1 + 1], &c__1);
352 F77_FUNC(strmm,STRMM)("Right", "Lower", "Transpose", "Unit", m, k, &one, &
353 v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[work_offset]
358 F77_FUNC(sgemm,SGEMM)("No transpose", "Transpose", m, k, &i__1, &one, &
359 c__[c_offset], ldc, &v[v_offset], ldv, &one, &
360 work[work_offset], ldwork);
363 F77_FUNC(strmm,STRMM)("Right", "Lower", trans, "Non-unit", m, k, &one, &t[
364 t_offset], ldt, &work[work_offset], ldwork);
369 F77_FUNC(sgemm,SGEMM)("No transpose", "No transpose", m, &i__1, k, &
370 minusone, &work[work_offset], ldwork, &v[v_offset],
371 ldv, &one, &c__[c_offset], ldc);
374 F77_FUNC(strmm,STRMM)("Right", "Lower", "No transpose", "Unit", m, k, &one,
375 &v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[
376 work_offset], ldwork);
379 for (j = 1; j <= i__1; ++j) {
381 for (i__ = 1; i__ <= i__2; ++i__) {
382 c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j *