ergo
|
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