src/gromacs/linearalgebra/gmx_lapack/sgeqr2.c

   1 #include "../gmx_lapack.h"
   2
   3
   4 void
   5 F77_FUNC(sgeqr2,SGEQR2)(int *m,
   6         int *n,
   7         float *a,
   8         int *lda,
   9         float *tau,
  10         float *work,
  11         int *info)
  12 {
  13   int k = (*m < *n) ? *m : *n;
  14   int i,i1,i2,i3;
  15   float aii;
  16
  17   *info = 0;
  18
  19   for(i=0;i<k;i++) {
  20     i1 = *m - i;
  21     i2 = ( (i+1) < (*m-1) ) ? (i+1) : (*m-1);
  22     i3 = 1;
  23     F77_FUNC(slarfg,SLARFG)(&i1,&(a[i*(*lda)+i]),&(a[i*(*lda)+i2]),&i3,&(tau[i]));
  24     if(i<(*n-1)) {
  25       aii = a[i*(*lda)+i];
  26       a[i*(*lda)+i] = 1.0;
  27       i2 = *n - i - 1;
  28       F77_FUNC(slarf,SLARF)("L",&i1,&i2,&(a[i*(*lda)+i]),&i3,&(tau[i]),
  29              &(a[(i+1)*(*lda)+i]),lda,work);
  30       a[i*(*lda)+i] = aii;
  31     }
  32   }
  33   return;
  34 }