3 #include "gmx_lapack.h"
4 #include "lapack_limits.h"
8 F77_FUNC(slatrd,SLATRD)(const char * uplo,
20 float one,zero,minusone,alpha;
21 const char ch=toupper(*uplo);
31 for(i=*n;i>=(*n-*nb+1);i--) {
38 F77_FUNC(sgemv,SGEMV)("N",&i,&ti1,&minusone, &(a[ i*(*lda) + 0]),lda,&(w[iw*(*ldw)+(i-1)]),
39 ldw,&one, &(a[ (i-1)*(*lda) + 0]), &ti2);
41 F77_FUNC(sgemv,SGEMV)("N",&i,&ti1,&minusone, &(w[ iw*(*ldw) + 0]),ldw,&(a[i*(*lda)+(i-1)]),
42 lda,&one, &(a[ (i-1)*(*lda) + 0]), &ti2);
46 /* Generate elementary reflector H(i) to annihilate
53 F77_FUNC(slarfg,SLARFG)(&ti1,&(a[(i-1)*(*lda)+(i-2)]),&(a[(i-1)*(*lda)+0]),&ti2,&(tau[i-2]));
55 e[i-2] = a[(i-1)*(*lda)+(i-2)];
56 a[(i-1)*(*lda)+(i-2)] = 1.0;
58 /* Compute W(1:i-1,i) */
63 F77_FUNC(ssymv,SSYMV)("U",&ti1,&one,a,lda,&(a[(i-1)*(*lda)+0]),&ti2,&zero,
64 &(w[(iw-1)*(*ldw)+0]),&ti2);
70 F77_FUNC(sgemv,SGEMV)("T",&ti1,&ti2,&one,&(w[iw*(*ldw)+0]),ldw,&(a[(i-1)*(*lda)+0]),&ti3,
71 &zero,&(w[(iw-1)*(*ldw)+i]),&ti3);
74 F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone,&(a[i*(*lda)+0]),lda,&(w[(iw-1)*(*ldw)+i]),&ti3,
75 &one,&(w[(iw-1)*(*ldw)+0]),&ti3);
78 F77_FUNC(sgemv,SGEMV)("T",&ti1,&ti2,&one,&(a[i*(*lda)+0]),lda,&(a[(i-1)*(*lda)+0]),&ti3,
79 &zero,&(w[(iw-1)*(*ldw)+i]),&ti3);
82 F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone,&(w[iw*(*ldw)+0]),ldw,&(w[(iw-1)*(*ldw)+i]),&ti3,
83 &one,&(w[(iw-1)*(*ldw)+0]),&ti3);
89 F77_FUNC(sscal,SSCAL)(&ti1,&(tau[i-2]),&(w[(iw-1)*(*ldw)+0]),&ti2);
91 alpha = -0.5*tau[i-2]*F77_FUNC(sdot,SDOT)(&ti1,&(w[(iw-1)*(*ldw)+0]),&ti2,
92 &(a[(i-1)*(*lda)+0]),&ti2);
95 F77_FUNC(saxpy,SAXPY)(&ti1,&alpha,&(a[(i-1)*(*lda)+0]),&ti2,&(w[(iw-1)*(*ldw)+0]),&ti2);
101 for(i=1;i<=*nb;i++) {
107 F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone, &(a[ i-1 ]),lda,&(w[ i-1 ]),
108 ldw,&one, &(a[ (i-1)*(*lda) + (i-1)]), &ti3);
110 F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone, &(w[ i-1 ]),ldw,&(a[ i-1 ]),
111 lda,&one, &(a[ (i-1)*(*lda) + (i-1)]), &ti3);
115 ti2 = (*n < i+2 ) ? *n : (i+2);
118 F77_FUNC(slarfg,SLARFG)(&ti1,&(a[(i-1)*(*lda)+(i)]),&(a[(i-1)*(*lda)+(ti2-1)]),&ti3,&(tau[i-1]));
119 e[i-1] = a[(i-1)*(*lda)+(i)];
120 a[(i-1)*(*lda)+(i)] = 1.0;
124 F77_FUNC(ssymv,SSYMV)("L",&ti1,&one,&(a[i*(*lda)+i]),lda,&(a[(i-1)*(*lda)+i]),&ti2,
125 &zero,&(w[(i-1)*(*ldw)+i]),&ti2);
130 F77_FUNC(sgemv,SGEMV)("T",&ti1,&ti2,&one,&(w[ i ]),ldw,&(a[(i-1)*(*lda)+i]),&ti3,
131 &zero,&(w[(i-1)*(*ldw)+0]),&ti3);
134 F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone,&(a[ i ]),lda,&(w[(i-1)*(*ldw)+0]),&ti3,
135 &one,&(w[(i-1)*(*ldw)+i]),&ti3);
138 F77_FUNC(sgemv,SGEMV)("T",&ti1,&ti2,&one,&(a[ i ]),lda,&(a[(i-1)*(*lda)+i]),&ti3,
139 &zero,&(w[(i-1)*(*ldw)+0]),&ti3);
142 F77_FUNC(sgemv,SGEMV)("N",&ti1,&ti2,&minusone,&(w[ i ]),ldw,&(w[(i-1)*(*ldw)+0]),&ti3,
143 &one,&(w[(i-1)*(*ldw)+i]),&ti3);
145 F77_FUNC(sscal,SSCAL)(&ti1,&(tau[i-1]),&(w[(i-1)*(*ldw)+i]),&ti3);
146 alpha = -0.5*tau[i-1]*F77_FUNC(sdot,SDOT)(&ti1,&(w[(i-1)*(*ldw)+i]),&ti3,
147 &(a[(i-1)*(*lda)+i]),&ti3);
149 F77_FUNC(saxpy,SAXPY)(&ti1,&alpha,&(a[(i-1)*(*lda)+i]),&ti3,&(w[(i-1)*(*ldw)+i]),&ti3);