src/gromacs/linearalgebra/gmx_lapack/dlaswp.c

   1 #include "../gmx_lapack.h"
   2
   3 /* LAPACK */
   4 void
   5 F77_FUNC(dlaswp,DLASWP)(int *n,
   6         double *a,
   7         int *lda,
   8         int *k1,
   9         int *k2,
  10         int *ipiv,
  11         int *incx)
  12 {
  13   int ix0,i1,i2,inc,n32;
  14   int ix,i,j,ip,k;
  15   double temp;
  16
  17   if(*incx>0) {
  18     ix0 = *k1 - 1;
  19     i1 = *k1 - 1;
  20     i2 = *k2;
  21     inc = 1;
  22   } else if(*incx<0) {
  23     ix0 = *incx * (1- *k2);
  24     i1 = *k2 - 1;
  25     i2 = *k1;
  26     inc = -1;
  27   } else
  28     return;
  29
  30   n32 = *n / 32;
  31
  32   n32 *= 32;
  33
  34
  35   if(n32!=0) {
  36     for(j=0;j<n32;j+=32) {
  37       ix = ix0;
  38       for(i=i1;i<i2;i+=inc,ix+=*incx) {
  39         ip = ipiv[ix] - 1;
  40         if(ip != i) {
  41           for(k=j;k<j+32;k++) {
  42             temp = a[(k)*(*lda)+i];
  43             a[(k)*(*lda)+i] = a[(k)*(*lda)+ip];
  44             a[(k)*(*lda)+ip] = temp;
  45           }
  46         }
  47       }
  48     }
  49   }
  50   if(n32!=*n) {
  51     ix = ix0;
  52     for(i=i1;i<i2;i+=inc,ix+=*incx) {
  53       ip = ipiv[ix] - 1;
  54       if(ip != i) {
  55         for(k=n32;k<*n;k++) {
  56             temp = a[(k)*(*lda)+i];
  57             a[(k)*(*lda)+i] = a[(k)*(*lda)+ip];
  58             a[(k)*(*lda)+ip] = temp;
  59         }
  60       }
  61     }
  62   }
  63   return;
  64 }