src/gromacs/linearalgebra/gmx_lapack/dlarf.c

   1 #include <math.h>
   2 #include <ctype.h>
   3
   4 #include "../gmx_blas.h"
   5 #include "../gmx_lapack.h"
   6
   7 #include "types/simple.h"
   8
   9 void
  10 F77_FUNC(dlarf,DLARF)(const char *side,
  11        int *m,
  12        int *n,
  13        double *v,
  14        int *incv,
  15        double *tau,
  16        double *c,
  17        int *ldc,
  18        double *work)
  19 {
  20   const char ch=toupper(*side);
  21   double one = 1.0;
  22   double zero = 0.0;
  23   double minustau = -(*tau);
  24   int i1 = 1;
  25
  26
  27   if(ch=='L') {
  28     if(fabs(*tau)>GMX_DOUBLE_MIN) {
  29       F77_FUNC(dgemv,DGEMV)("T",m,n,&one,c,ldc,v,incv,&zero,work,&i1);
  30       F77_FUNC(dger,DGER)(m,n,&minustau,v,incv,work,&i1,c,ldc);
  31     }
  32   } else {
  33     if(fabs(*tau)>GMX_DOUBLE_MIN) {
  34       F77_FUNC(dgemv,DGEMV)("N",m,n,&one,c,ldc,v,incv,&zero,work,&i1);
  35       F77_FUNC(dger,DGER)(m,n,&minustau,work,&i1,v,incv,c,ldc);
  36     }
  37   }
  38   return;
  39 }