2 #include "gromacs/utility/real.h"
4 #include "../gmx_blas.h"
5 #include "../gmx_lapack.h"
6 #include "lapack_limits.h"
10 F77_FUNC(slarfg,SLARFG)(int *n,
18 float minval,safmin,rsafmn,beta;
27 xnorm = F77_FUNC(snrm2,SNRM2)(&ti1,x,incx);
29 if(fabs(xnorm)<GMX_FLOAT_MIN) {
33 t = F77_FUNC(slapy2,SLAPY2)(alpha,&xnorm);
40 minval = GMX_FLOAT_MIN;
42 safmin = minval*(1.0+GMX_FLOAT_EPS) / GMX_FLOAT_EPS;
45 if(fabs(beta)<safmin) {
48 rsafmn = 1.0 / safmin;
50 while(fabs(beta)<safmin) {
53 F77_FUNC(sscal,SSCAL)(&ti1,&rsafmn,x,incx);
58 /* safmin <= beta <= 1 now */
60 xnorm = F77_FUNC(snrm2,SNRM2)(&ti1,x,incx);
61 t = F77_FUNC(slapy2,SLAPY2)(alpha,&xnorm);
68 *tau = (beta-*alpha)/beta;
71 t = 1.0/(*alpha-beta);
72 F77_FUNC(sscal,SSCAL)(&ti1,&t,x,incx);
78 *tau = (beta-*alpha)/beta;
80 t = 1.0/(*alpha-beta);
81 F77_FUNC(sscal,SSCAL)(&ti1,&t,x,incx);