template_lapack_lanst.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_LANST_HEADER
00036 #define TEMPLATE_LAPACK_LANST_HEADER
00037 
00038 
00039 template<class Treal>
00040 Treal template_lapack_lanst(const char *norm, const integer *n, const Treal *d__, const Treal *e)
00041 {
00042 /*  -- LAPACK auxiliary routine (version 3.0) --   
00043        Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
00044        Courant Institute, Argonne National Lab, and Rice University   
00045        February 29, 1992   
00046 
00047 
00048     Purpose   
00049     =======   
00050 
00051     DLANST  returns the value of the one norm,  or the Frobenius norm, or   
00052     the  infinity norm,  or the  element of  largest absolute value  of a   
00053     real symmetric tridiagonal matrix A.   
00054 
00055     Description   
00056     ===========   
00057 
00058     DLANST returns the value   
00059 
00060        DLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm'   
00061                 (   
00062                 ( norm1(A),         NORM = '1', 'O' or 'o'   
00063                 (   
00064                 ( normI(A),         NORM = 'I' or 'i'   
00065                 (   
00066                 ( normF(A),         NORM = 'F', 'f', 'E' or 'e'   
00067 
00068     where  norm1  denotes the  one norm of a matrix (maximum column sum),   
00069     normI  denotes the  infinity norm  of a matrix  (maximum row sum) and   
00070     normF  denotes the  Frobenius norm of a matrix (square root of sum of   
00071     squares).  Note that  max(abs(A(i,j)))  is not a  matrix norm.   
00072 
00073     Arguments   
00074     =========   
00075 
00076     NORM    (input) CHARACTER*1   
00077             Specifies the value to be returned in DLANST as described   
00078             above.   
00079 
00080     N       (input) INTEGER   
00081             The order of the matrix A.  N >= 0.  When N = 0, DLANST is   
00082             set to zero.   
00083 
00084     D       (input) DOUBLE PRECISION array, dimension (N)   
00085             The diagonal elements of A.   
00086 
00087     E       (input) DOUBLE PRECISION array, dimension (N-1)   
00088             The (n-1) sub-diagonal or super-diagonal elements of A.   
00089 
00090     =====================================================================   
00091 
00092 
00093        Parameter adjustments */
00094     /* Table of constant values */
00095      integer c__1 = 1;
00096     
00097     /* System generated locals */
00098     integer i__1;
00099     Treal ret_val, d__1, d__2, d__3, d__4, d__5;
00100     /* Local variables */
00101      integer i__;
00102      Treal scale;
00103      Treal anorm;
00104      Treal sum;
00105 
00106 
00107     --e;
00108     --d__;
00109 
00110     /* Initialization added by Elias to get rid of compiler warnings. */
00111     anorm = 0;
00112     /* Function Body */
00113     if (*n <= 0) {
00114         anorm = 0.;
00115     } else if (template_blas_lsame(norm, "M")) {
00116 
00117 /*        Find max(abs(A(i,j))). */
00118 
00119         anorm = (d__1 = d__[*n], absMACRO(d__1));
00120         i__1 = *n - 1;
00121         for (i__ = 1; i__ <= i__1; ++i__) {
00122 /* Computing MAX */
00123             d__2 = anorm, d__3 = (d__1 = d__[i__], absMACRO(d__1));
00124             anorm = maxMACRO(d__2,d__3);
00125 /* Computing MAX */
00126             d__2 = anorm, d__3 = (d__1 = e[i__], absMACRO(d__1));
00127             anorm = maxMACRO(d__2,d__3);
00128 /* L10: */
00129         }
00130     } else if (template_blas_lsame(norm, "O") || *(unsigned char *)
00131             norm == '1' || template_blas_lsame(norm, "I")) {
00132 
00133 /*        Find norm1(A). */
00134 
00135         if (*n == 1) {
00136             anorm = absMACRO(d__[1]);
00137         } else {
00138 /* Computing MAX */
00139             d__3 = absMACRO(d__[1]) + absMACRO(e[1]), d__4 = (d__1 = e[*n - 1], absMACRO(
00140                     d__1)) + (d__2 = d__[*n], absMACRO(d__2));
00141             anorm = maxMACRO(d__3,d__4);
00142             i__1 = *n - 1;
00143             for (i__ = 2; i__ <= i__1; ++i__) {
00144 /* Computing MAX */
00145                 d__4 = anorm, d__5 = (d__1 = d__[i__], absMACRO(d__1)) + (d__2 = e[
00146                         i__], absMACRO(d__2)) + (d__3 = e[i__ - 1], absMACRO(d__3));
00147                 anorm = maxMACRO(d__4,d__5);
00148 /* L20: */
00149             }
00150         }
00151     } else if (template_blas_lsame(norm, "F") || template_blas_lsame(norm, "E")) {
00152 
00153 /*        Find normF(A). */
00154 
00155         scale = 0.;
00156         sum = 1.;
00157         if (*n > 1) {
00158             i__1 = *n - 1;
00159             template_lapack_lassq(&i__1, &e[1], &c__1, &scale, &sum);
00160             sum *= 2;
00161         }
00162         template_lapack_lassq(n, &d__[1], &c__1, &scale, &sum);
00163         anorm = scale * template_blas_sqrt(sum);
00164     }
00165 
00166     ret_val = anorm;
00167     return ret_val;
00168 
00169 /*     End of DLANST */
00170 
00171 } /* dlanst_ */
00172 
00173 #endif

Generated on Wed Nov 21 09:32:11 2012 for ergo by  doxygen 1.4.7