template_lapack_rscl.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_LAPACK_RSCL_HEADER
00036 #define TEMPLATE_LAPACK_RSCL_HEADER
00037 
00038 
00039 template<class Treal>
00040 int template_lapack_rscl(const integer *n, const Treal *sa, Treal *sx, 
00041         const integer *incx)
00042 {
00043 /*  -- LAPACK auxiliary routine (version 3.0) --   
00044        Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
00045        Courant Institute, Argonne National Lab, and Rice University   
00046        September 30, 1994   
00047 
00048 
00049     Purpose   
00050     =======   
00051 
00052     DRSCL multiplies an n-element real vector x by the real scalar 1/a.   
00053     This is done without overflow or underflow as long as   
00054     the final result x/a does not overflow or underflow.   
00055 
00056     Arguments   
00057     =========   
00058 
00059     N       (input) INTEGER   
00060             The number of components of the vector x.   
00061 
00062     SA      (input) DOUBLE PRECISION   
00063             The scalar a which is used to divide each component of x.   
00064             SA must be >= 0, or the subroutine will divide by zero.   
00065 
00066     SX      (input/output) DOUBLE PRECISION array, dimension   
00067                            (1+(N-1)*abs(INCX))   
00068             The n-element vector x.   
00069 
00070     INCX    (input) INTEGER   
00071             The increment between successive values of the vector SX.   
00072             > 0:  SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i),     1< i<= n   
00073 
00074    =====================================================================   
00075 
00076 
00077        Quick return if possible   
00078 
00079        Parameter adjustments */
00080      Treal cden;
00081      logical done;
00082      Treal cnum, cden1, cnum1;
00083      Treal bignum, smlnum, mul;
00084 
00085     --sx;
00086 
00087     /* Function Body */
00088     if (*n <= 0) {
00089         return 0;
00090     }
00091 
00092 /*     Get machine parameters */
00093 
00094     smlnum = template_lapack_lamch("S", (Treal)0);
00095     bignum = 1. / smlnum;
00096     template_lapack_labad(&smlnum, &bignum);
00097 
00098 /*     Initialize the denominator to SA and the numerator to 1. */
00099 
00100     cden = *sa;
00101     cnum = 1.;
00102 
00103 L10:
00104     cden1 = cden * smlnum;
00105     cnum1 = cnum / bignum;
00106     if (absMACRO(cden1) > absMACRO(cnum) && cnum != 0.) {
00107 
00108 /*        Pre-multiply X by SMLNUM if CDEN is large compared to CNUM. */
00109 
00110         mul = smlnum;
00111         done = FALSE_;
00112         cden = cden1;
00113     } else if (absMACRO(cnum1) > absMACRO(cden)) {
00114 
00115 /*        Pre-multiply X by BIGNUM if CDEN is small compared to CNUM. */
00116 
00117         mul = bignum;
00118         done = FALSE_;
00119         cnum = cnum1;
00120     } else {
00121 
00122 /*        Multiply X by CNUM / CDEN and return. */
00123 
00124         mul = cnum / cden;
00125         done = TRUE_;
00126     }
00127 
00128 /*     Scale the vector X by MUL */
00129 
00130     dscal_(n, &mul, &sx[1], incx);
00131 
00132     if (! done) {
00133         goto L10;
00134     }
00135 
00136     return 0;
00137 
00138 /*     End of DRSCL */
00139 
00140 } /* drscl_ */
00141 
00142 #endif

Generated on 21 Nov 2012 for ergo by  doxygen 1.6.1