2 #include "types/simple.h"
4 #include "../gmx_blas.h"
5 #include "../gmx_lapack.h"
6 #include "lapack_limits.h"
10 F77_FUNC(dlarfg,DLARFG)(int *n,
18 double minval,safmin,rsafmn,beta;
27 xnorm = F77_FUNC(dnrm2,DNRM2)(&ti1,x,incx);
29 if(fabs(xnorm)<GMX_DOUBLE_MIN) {
33 t = F77_FUNC(dlapy2,DLAPY2)(alpha,&xnorm);
40 minval = GMX_DOUBLE_MIN;
42 safmin = minval*(1.0+GMX_DOUBLE_EPS) / GMX_DOUBLE_EPS;
45 if(fabs(beta)<safmin) {
48 rsafmn = 1.0 / safmin;
50 while(fabs(beta)<safmin) {
53 F77_FUNC(dscal,DSCAL)(&ti1,&rsafmn,x,incx);
58 /* safmin <= beta <= 1 now */
60 xnorm = F77_FUNC(dnrm2,DNRM2)(&ti1,x,incx);
61 t = F77_FUNC(dlapy2,DLAPY2)(alpha,&xnorm);
68 *tau = (beta-*alpha)/beta;
71 t = 1.0/(*alpha-beta);
72 F77_FUNC(dscal,DSCAL)(&ti1,&t,x,incx);
78 *tau = (beta-*alpha)/beta;
80 t = 1.0/(*alpha-beta);
81 F77_FUNC(dscal,DSCAL)(&ti1,&t,x,incx);