src/gmxlib/gmx_blas/dasum.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 double
  39 F77_FUNC(dasum,DASUM)(int *n__,
  40                       double *dx,
  41                       int *incx__)
  42 {
  43     int i__1, i__2;
  44
  45     int i__, m, mp1;
  46     double dtemp;
  47     int nincx;
  48
  49     int n = *n__;
  50     int incx = *incx__;
  51
  52     --dx;
  53
  54     dtemp = 0.;
  55     if (n <= 0 || incx <= 0) {
  56         return 0.0;
  57     }
  58     if (incx != 1) {
  59         nincx = n * incx;
  60         i__1 = nincx;
  61         i__2 = incx;
  62         for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
  63             dtemp += fabs(dx[i__]);
  64         }
  65         return dtemp;
  66     }
  67
  68     m = n % 6;
  69     if (m != 0) {
  70         i__2 = m;
  71         for (i__ = 1; i__ <= i__2; ++i__) {
  72             dtemp += fabs(dx[i__]);
  73         }
  74         if (n < 6) {
  75             return dtemp;
  76         }
  77     }
  78     mp1 = m + 1;
  79     i__2 = n;
  80     for (i__ = mp1; i__ <= i__2; i__ += 6) {
  81         dtemp = dtemp + fabs(dx[i__]) + fabs(dx[i__ + 1]) +
  82         fabs(dx[i__ + 2]) + fabs(dx[i__+ 3]) + fabs(dx[i__ + 4]) +
  83         fabs(dx[i__ + 5]);
  84     }
  85     return dtemp;
  86 }
  87
  88