template_blas_nrm2.h

Go to the documentation of this file.
00001 /* Ergo, version 3.2, a program for linear scaling electronic structure
00002  * calculations.
00003  * Copyright (C) 2012 Elias Rudberg, Emanuel H. Rubensson, and Pawel Salek.
00004  * 
00005  * This program is free software: you can redistribute it and/or modify
00006  * it under the terms of the GNU General Public License as published by
00007  * the Free Software Foundation, either version 3 of the License, or
00008  * (at your option) any later version.
00009  * 
00010  * This program is distributed in the hope that it will be useful,
00011  * but WITHOUT ANY WARRANTY; without even the implied warranty of
00012  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00013  * GNU General Public License for more details.
00014  * 
00015  * You should have received a copy of the GNU General Public License
00016  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
00017  * 
00018  * Primary academic reference:
00019  * Kohn−Sham Density Functional Theory Electronic Structure Calculations 
00020  * with Linearly Scaling Computational Time and Memory Usage,
00021  * Elias Rudberg, Emanuel H. Rubensson, and Pawel Salek,
00022  * J. Chem. Theory Comput. 7, 340 (2011),
00023  * <http://dx.doi.org/10.1021/ct100611z>
00024  * 
00025  * For further information about Ergo, see <http://www.ergoscf.org>.
00026  */
00027  
00028  /* This file belongs to the template_lapack part of the Ergo source 
00029   * code. The source files in the template_lapack directory are modified
00030   * versions of files originally distributed as CLAPACK, see the
00031   * Copyright/license notice in the file template_lapack/COPYING.
00032   */
00033  
00034 
00035 #ifndef TEMPLATE_BLAS_NRM2_HEADER
00036 #define TEMPLATE_BLAS_NRM2_HEADER
00037 
00038 
00039 template<class Treal>
00040 Treal template_blas_nrm2(const integer *n, const Treal *x, const integer *incx)
00041 {
00042 /*        The following loop is equivalent to this call to the LAPACK   
00043           auxiliary routine:   
00044           CALL DLASSQ( N, X, INCX, SCALE, SSQ ) */
00045     /* System generated locals */
00046     integer i__1, i__2;
00047     Treal ret_val, d__1;
00048     /* Local variables */
00049      Treal norm, scale, absxi;
00050      integer ix;
00051      Treal ssq;
00052 /*  DNRM2 returns the euclidean norm of a vector via the function   
00053     name, so that   
00054        DNRM2 := sqrt( x'*x )   
00055     -- This version written on 25-October-1982.   
00056        Modified on 14-October-1993 to inline the call to DLASSQ.   
00057        Sven Hammarling, Nag Ltd.   
00058        Parameter adjustments */
00059     --x;
00060     /* Function Body */
00061     if (*n < 1 || *incx < 1) {
00062         norm = 0.;
00063     } else if (*n == 1) {
00064         norm = absMACRO(x[1]);
00065     } else {
00066         scale = 0.;
00067         ssq = 1.;
00068 
00069 
00070         i__1 = (*n - 1) * *incx + 1;
00071         i__2 = *incx;
00072         for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
00073             if (x[ix] != 0.) {
00074                 absxi = (d__1 = x[ix], absMACRO(d__1));
00075                 if (scale < absxi) {
00076 /* Computing 2nd power */
00077                     d__1 = scale / absxi;
00078                     ssq = ssq * (d__1 * d__1) + 1.;
00079                     scale = absxi;
00080                 } else {
00081 /* Computing 2nd power */
00082                     d__1 = absxi / scale;
00083                     ssq += d__1 * d__1;
00084                 }
00085             }
00086 /* L10: */
00087         }
00088         norm = scale * template_blas_sqrt(ssq);
00089     }
00090 
00091     ret_val = norm;
00092     return ret_val;
00093 
00094 /*     End of DNRM2. */
00095 
00096 } /* dnrm2_ */
00097 
00098 #endif

Generated on Mon Sep 17 14:32:56 2012 for ergo by  doxygen 1.4.7