src/gromacs/linearalgebra/gmx_lapack/slassq.c

   1 #include <math.h>
   2 #include "types/simple.h"
   3 #include "../gmx_lapack.h"
   4
   5 void
   6 F77_FUNC(slassq,SLASSQ)(int *n,
   7                         float *x,
   8                         int *incx,
   9                         float *scale,
  10                         float *sumsq)
  11 {
  12   int ix;
  13   float absxi,t;
  14
  15   if(*n>0) {
  16     for(ix=0;ix<=(*n-1)*(*incx);ix+=*incx) {
  17       if(fabs(x[ix])>GMX_FLOAT_MIN) {
  18         absxi = fabs(x[ix]);
  19         if(*scale<absxi) {
  20           t = *scale/absxi;
  21           t = t*t;
  22           *sumsq = 1.0 + (*sumsq)*t;
  23           *scale = absxi;
  24         } else {
  25           t = absxi/(*scale);
  26           *sumsq += t*t;
  27         }
  28       }
  29     }
  30   }
  31   return;
  32 }