src/gmxlib/gmx_lapack/dgelq2.c

   1 #include "gmx_lapack.h"
   2
   3 void
   4 F77_FUNC(dgelq2,DGELQ2)(int *m,
   5                         int *n,
   6                         double *a,
   7                         int *lda,
   8                         double *tau,
   9                         double *work,
  10                         int *info)
  11 {
  12     /* System generated locals */
  13     int a_dim1, a_offset, i__1, i__2, i__3, i__4;
  14
  15     /* Local variables */
  16     int i__, k;
  17     double aii;
  18
  19     a_dim1 = *lda;
  20     a_offset = 1 + a_dim1;
  21     a -= a_offset;
  22     --tau;
  23     --work;
  24
  25     *info = 0;
  26
  27     i__4 = (*m > 1) ? *m : 1;
  28
  29     if (*m < 0) {
  30         *info = -1;
  31     } else if (*n < 0) {
  32         *info = -2;
  33     } else if (*lda < i__4) {
  34         *info = -4;
  35     }
  36     if (*info != 0) {
  37         return;
  38     }
  39
  40
  41     k = (*m < *n ) ? *m : *n;
  42     i__1 = k;
  43     for (i__ = 1; i__ <= i__1; ++i__) {
  44         i__2 = *n - i__ + 1;
  45         i__3 = i__ + 1;
  46     i__4 = (i__3 < *n) ? i__3 : *n;
  47         F77_FUNC(dlarfg,DLARFG)(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + i__4 * a_dim1],
  48                             lda, &tau[i__]);
  49         if (i__ < *m) {
  50             aii = a[i__ + i__ * a_dim1];
  51             a[i__ + i__ * a_dim1] = 1.f;
  52             i__2 = *m - i__;
  53             i__3 = *n - i__ + 1;
  54             F77_FUNC(dlarf,DLARF)("R", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda,
  55                               &tau[i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
  56             a[i__ + i__ * a_dim1] = aii;
  57         }
  58     }
  59     return;
  60 }
  61
  62