template_lapack_lange.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_LANGE_HEADER
00036 #define TEMPLATE_LAPACK_LANGE_HEADER
00037 
00038 
00039 template<class Treal>
00040 Treal template_lapack_lange(const char *norm, const integer *m, const integer *n, const Treal *a, const integer 
00041         *lda, Treal *work)
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        October 31, 1992   
00047 
00048 
00049     Purpose   
00050     =======   
00051 
00052     DLANGE  returns the value of the one norm,  or the Frobenius norm, or   
00053     the  infinity norm,  or the  element of  largest absolute value  of a   
00054     real matrix A.   
00055 
00056     Description   
00057     ===========   
00058 
00059     DLANGE returns the value   
00060 
00061        DLANGE = ( maxMACRO(abs(A(i,j))), NORM = 'M' or 'm'   
00062                 (   
00063                 ( norm1(A),         NORM = '1', 'O' or 'o'   
00064                 (   
00065                 ( normI(A),         NORM = 'I' or 'i'   
00066                 (   
00067                 ( normF(A),         NORM = 'F', 'f', 'E' or 'e'   
00068 
00069     where  norm1  denotes the  one norm of a matrix (maximum column sum),   
00070     normI  denotes the  infinity norm  of a matrix  (maximum row sum) and   
00071     normF  denotes the  Frobenius norm of a matrix (square root of sum of   
00072     squares).  Note that  maxMACRO(abs(A(i,j)))  is not a  matrix norm.   
00073 
00074     Arguments   
00075     =========   
00076 
00077     NORM    (input) CHARACTER*1   
00078             Specifies the value to be returned in DLANGE as described   
00079             above.   
00080 
00081     M       (input) INTEGER   
00082             The number of rows of the matrix A.  M >= 0.  When M = 0,   
00083             DLANGE is set to zero.   
00084 
00085     N       (input) INTEGER   
00086             The number of columns of the matrix A.  N >= 0.  When N = 0,   
00087             DLANGE is set to zero.   
00088 
00089     A       (input) DOUBLE PRECISION array, dimension (LDA,N)   
00090             The m by n matrix A.   
00091 
00092     LDA     (input) INTEGER   
00093             The leading dimension of the array A.  LDA >= maxMACRO(M,1).   
00094 
00095     WORK    (workspace) DOUBLE PRECISION array, dimension (LWORK),   
00096             where LWORK >= M when NORM = 'I'; otherwise, WORK is not   
00097             referenced.   
00098 
00099    =====================================================================   
00100 
00101 
00102        Parameter adjustments */
00103     /* Table of constant values */
00104      integer c__1 = 1;
00105     
00106     /* System generated locals */
00107     integer a_dim1, a_offset, i__1, i__2;
00108     Treal ret_val, d__1, d__2, d__3;
00109     /* Local variables */
00110      integer i__, j;
00111      Treal scale;
00112      Treal value;
00113      Treal sum;
00114 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
00115 
00116 
00117     a_dim1 = *lda;
00118     a_offset = 1 + a_dim1 * 1;
00119     a -= a_offset;
00120     --work;
00121 
00122     /* Initialization added by Elias to get rid of compiler warnings. */
00123     value = 0;
00124     /* Function Body */
00125     if (minMACRO(*m,*n) == 0) {
00126         value = 0.;
00127     } else if (template_blas_lsame(norm, "M")) {
00128 
00129 /*        Find maxMACRO(abs(A(i,j))). */
00130 
00131         value = 0.;
00132         i__1 = *n;
00133         for (j = 1; j <= i__1; ++j) {
00134             i__2 = *m;
00135             for (i__ = 1; i__ <= i__2; ++i__) {
00136 /* Computing MAX */
00137                 d__2 = value, d__3 = (d__1 = a_ref(i__, j), absMACRO(d__1));
00138                 value = maxMACRO(d__2,d__3);
00139 /* L10: */
00140             }
00141 /* L20: */
00142         }
00143     } else if (template_blas_lsame(norm, "O") || *(unsigned char *)
00144             norm == '1') {
00145 
00146 /*        Find norm1(A). */
00147 
00148         value = 0.;
00149         i__1 = *n;
00150         for (j = 1; j <= i__1; ++j) {
00151             sum = 0.;
00152             i__2 = *m;
00153             for (i__ = 1; i__ <= i__2; ++i__) {
00154                 sum += (d__1 = a_ref(i__, j), absMACRO(d__1));
00155 /* L30: */
00156             }
00157             value = maxMACRO(value,sum);
00158 /* L40: */
00159         }
00160     } else if (template_blas_lsame(norm, "I")) {
00161 
00162 /*        Find normI(A). */
00163 
00164         i__1 = *m;
00165         for (i__ = 1; i__ <= i__1; ++i__) {
00166             work[i__] = 0.;
00167 /* L50: */
00168         }
00169         i__1 = *n;
00170         for (j = 1; j <= i__1; ++j) {
00171             i__2 = *m;
00172             for (i__ = 1; i__ <= i__2; ++i__) {
00173                 work[i__] += (d__1 = a_ref(i__, j), absMACRO(d__1));
00174 /* L60: */
00175             }
00176 /* L70: */
00177         }
00178         value = 0.;
00179         i__1 = *m;
00180         for (i__ = 1; i__ <= i__1; ++i__) {
00181 /* Computing MAX */
00182             d__1 = value, d__2 = work[i__];
00183             value = maxMACRO(d__1,d__2);
00184 /* L80: */
00185         }
00186     } else if (template_blas_lsame(norm, "F") || template_blas_lsame(norm, "E")) {
00187 
00188 /*        Find normF(A). */
00189 
00190         scale = 0.;
00191         sum = 1.;
00192         i__1 = *n;
00193         for (j = 1; j <= i__1; ++j) {
00194             template_lapack_lassq(m, &a_ref(1, j), &c__1, &scale, &sum);
00195 /* L90: */
00196         }
00197         value = scale * template_blas_sqrt(sum);
00198     }
00199 
00200     ret_val = value;
00201     return ret_val;
00202 
00203 /*     End of DLANGE */
00204 
00205 } /* dlange_ */
00206 
00207 #undef a_ref
00208 
00209 
00210 #endif

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