src/gromacs/linearalgebra/gmx_blas/sger.c

   1 #include <math.h>
   2
   3 #include "gromacs/utility/real.h"
   4 #include "../gmx_blas.h"
   5
   6 void
   7 F77_FUNC(sger,SGER)(int *m__,
   8                     int *n__,
   9                     float *alpha__,
  10                     float *x,
  11                     int *incx__,
  12                     float *y,
  13                     int *incy__,
  14                     float *a,
  15                     int *lda__)
  16 {
  17     int ix,kx,jy;
  18     int i,j;
  19     float temp;
  20
  21     int m = *m__;
  22     int n = *n__;
  23     int incx = *incx__;
  24     int incy = *incy__;
  25     int lda = *lda__;
  26     float alpha = *alpha__;
  27
  28     if(m<=0 || n<=0 || fabs(alpha)<GMX_FLOAT_MIN)
  29         return;
  30
  31     if(incy>0)
  32         jy = 0;
  33     else
  34         jy = incy * (1 - n);
  35
  36     if(incx==1) {
  37         for(j=0;j<n;j++,jy+=incy)
  38             if(fabs(y[jy])>GMX_FLOAT_MIN) {
  39                 temp = alpha * y[jy];
  40                 for(i=0;i<m;i++)
  41                     a[j*(lda)+i] += temp*x[i];
  42             }
  43     } else {
  44         /* non-unit incx */
  45         if(incx>0)
  46             kx = 0;
  47         else
  48             kx = incx * (1 - m);
  49
  50         for(j=0;j<n;j++,jy+=incy) {
  51             if(fabs(y[jy])>GMX_FLOAT_MIN) {
  52                 temp = alpha * y[jy];
  53                 ix = kx;
  54                 for(i=0;i<m;i++,ix+=incx)
  55                     a[j*(lda)+i] += temp*x[ix];
  56             }
  57         }
  58     }
  59         return;
  60 }