src/gmxlib/gmx_blas/sasum.c

   1 /*
   2  * This file is part of the GROMACS molecular simulation package.
   3  *
   4  * Copyright (c) 2012,2013, 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 <math.h>
  36 #include "gmx_blas.h"
  37
  38 float
  39 F77_FUNC(sasum,SASUM)(int *n__,
  40        float *dx,
  41        int *incx__)
  42 {
  43     int i__1, i__2;
  44
  45     int i__, m, mp1;
  46     float dtemp;
  47     int nincx;
  48
  49     int n = *n__;
  50     int incx = *incx__;
  51
  52
  53     --dx;
  54
  55     dtemp = 0.;
  56     if (n <= 0 || incx <= 0) {
  57         return 0.0;
  58     }
  59     if (incx != 1) {
  60         nincx = n * incx;
  61         i__1 = nincx;
  62         i__2 = incx;
  63         for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
  64             dtemp += fabs(dx[i__]);
  65         }
  66         return dtemp;
  67     }
  68
  69     m = n % 6;
  70     if (m != 0) {
  71         i__2 = m;
  72         for (i__ = 1; i__ <= i__2; ++i__) {
  73             dtemp += fabs(dx[i__]);
  74         }
  75         if (n < 6) {
  76             return dtemp;
  77         }
  78     }
  79     mp1 = m + 1;
  80     i__2 = n;
  81     for (i__ = mp1; i__ <= i__2; i__ += 6) {
  82         dtemp = dtemp + fabs(dx[i__]) + fabs(dx[i__ + 1]) +
  83         fabs(dx[i__ + 2]) + fabs(dx[i__+ 3]) + fabs(dx[i__ + 4]) +
  84         fabs(dx[i__ + 5]);
  85     }
  86     return dtemp;
  87 }
  88
  89