src/gmxlib/gmx_lapack/sgelq2.c

   1 /*
   2  * This file is part of the GROMACS molecular simulation package.
   3  *
   4  * Copyright (c) 2012, by the GROMACS development team, led by
   5  * David van der Spoel, Berk Hess, Erik Lindahl, and including many
   6  * others, as listed in the AUTHORS file in the top-level source
   7  * directory and at http://www.gromacs.org.
   8  *
   9  * GROMACS is free software; you can redistribute it and/or
  10  * modify it under the terms of the GNU Lesser General Public License
  11  * as published by the Free Software Foundation; either version 2.1
  12  * of the License, or (at your option) any later version.
  13  *
  14  * GROMACS is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17  * Lesser General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU Lesser General Public
  20  * License along with GROMACS; if not, see
  21  * http://www.gnu.org/licenses, or write to the Free Software Foundation,
  22  * Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA.
  23  *
  24  * If you want to redistribute modifications to GROMACS, please
  25  * consider that scientific software is very special. Version
  26  * control is crucial - bugs must be traceable. We will be happy to
  27  * consider code for inclusion in the official distribution, but
  28  * derived work must not be called official GROMACS. Details are found
  29  * in the README & COPYING files - if they are missing, get the
  30  * official version at http://www.gromacs.org.
  31  *
  32  * To help us fund GROMACS development, we humbly ask that you cite
  33  * the research papers on the package. Check out http://www.gromacs.org.
  34  */
  35 #include "gmx_lapack.h"
  36
  37 void
  38 F77_FUNC(sgelq2,SGELQ2)(int *m,
  39                         int *n,
  40                         float *a,
  41                         int *lda,
  42                         float *tau,
  43                         float *work,
  44                         int *info)
  45 {
  46     /* System generated locals */
  47     int a_dim1, a_offset, i__1, i__2, i__3, i__4;
  48
  49     /* Local variables */
  50     int i__, k;
  51     float aii;
  52
  53     a_dim1 = *lda;
  54     a_offset = 1 + a_dim1;
  55     a -= a_offset;
  56     --tau;
  57     --work;
  58
  59     *info = 0;
  60
  61     i__4 = (*m > 1) ? *m : 1;
  62
  63     if (*m < 0) {
  64         *info = -1;
  65     } else if (*n < 0) {
  66         *info = -2;
  67     } else if (*lda < i__4) {
  68         *info = -4;
  69     }
  70     if (*info != 0) {
  71         return;
  72     }
  73
  74
  75     k = (*m < *n ) ? *m : *n;
  76     i__1 = k;
  77     for (i__ = 1; i__ <= i__1; ++i__) {
  78         i__2 = *n - i__ + 1;
  79         i__3 = i__ + 1;
  80     i__4 = (i__3 < *n) ? i__3 : *n;
  81         F77_FUNC(slarfg,SLARFG)(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + i__4 * a_dim1],
  82             lda, &tau[i__]);
  83         if (i__ < *m) {
  84             aii = a[i__ + i__ * a_dim1];
  85             a[i__ + i__ * a_dim1] = 1.f;
  86             i__2 = *m - i__;
  87             i__3 = *n - i__ + 1;
  88             F77_FUNC(slarf,SLARF)("R", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda,
  89                &tau[i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
  90             a[i__ + i__ * a_dim1] = aii;
  91         }
  92     }
  93     return;
  94 }
  95
  96