src/gromacs/linearalgebra/gmx_lapack/dgetrs.cpp

   1 #include "../gmx_blas.h"
   2 #include "../gmx_lapack.h"
   3
   4 void
   5 F77_FUNC(dgetrs,DGETRS)(const char *trans,
   6         int *n,
   7         int *nrhs,
   8         double *a,
   9         int *lda,
  10         int *ipiv,
  11         double *b,
  12         int *ldb,
  13         int *info)
  14 {
  15     int a_dim1, a_offset, b_dim1, b_offset;
  16     int notran;
  17     int c__1 = 1;
  18     int c_n1 = -1;
  19     double one = 1.0;
  20
  21     a_dim1 = *lda;
  22     a_offset = 1 + a_dim1;
  23     a -= a_offset;
  24     --ipiv;
  25     b_dim1 = *ldb;
  26     b_offset = 1 + b_dim1;
  27     b -= b_offset;
  28
  29     *info = 0;
  30     notran = (*trans=='N' || *trans=='n');
  31
  32     if (*n <= 0 || *nrhs <= 0)
  33         return;
  34
  35     if (notran) {
  36         F77_FUNC(dlaswp,DLASWP)(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c__1);
  37         F77_FUNC(dtrsm,DTRSM)("Left", "Lower", "No transpose", "Unit", n, nrhs, &one,
  38                &a[a_offset], lda, &b[b_offset], ldb);
  39
  40         F77_FUNC(dtrsm,DTRSM)("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &one,
  41                &a[a_offset], lda, &b[b_offset], ldb);
  42     } else {
  43         F77_FUNC(dtrsm,DTRSM)("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &one,
  44                &a[a_offset], lda, &b[b_offset], ldb);
  45         F77_FUNC(dtrsm,DTRSM)("Left", "Lower", "Transpose", "Unit", n, nrhs, &one,
  46                &a[a_offset], lda, &b[b_offset], ldb);
  47
  48         F77_FUNC(dlaswp,DLASWP)(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c_n1);
  49     }
  50
  51     return;
  52
  53 }