src/gmxlib/gmx_lapack/dlassq.c

   1 #include <math.h>
   2 #include <types/simple.h>
   3 #include "gmx_lapack.h"
   4
   5 void
   6 F77_FUNC(dlassq,DLASSQ)(int *n,
   7                         double *x,
   8                         int *incx,
   9                         double *scale,
  10                         double *sumsq)
  11 {
  12   int ix;
  13   double absxi,t;
  14
  15   if(*n>0) {
  16     for(ix=0;ix<=(*n-1)*(*incx);ix+=*incx) {
  17       if(fabs(x[ix])>GMX_DOUBLE_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 }