00001 /* Ergo, version 3.7, a program for linear scaling electronic structure 00002 * calculations. 00003 * Copyright (C) 2018 Elias Rudberg, Emanuel H. Rubensson, Pawel Salek, 00004 * and Anastasia Kruchinina. 00005 * 00006 * This program is free software: you can redistribute it and/or modify 00007 * it under the terms of the GNU General Public License as published by 00008 * the Free Software Foundation, either version 3 of the License, or 00009 * (at your option) any later version. 00010 * 00011 * This program is distributed in the hope that it will be useful, 00012 * but WITHOUT ANY WARRANTY; without even the implied warranty of 00013 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00014 * GNU General Public License for more details. 00015 * 00016 * You should have received a copy of the GNU General Public License 00017 * along with this program. If not, see <http://www.gnu.org/licenses/>. 00018 * 00019 * Primary academic reference: 00020 * Ergo: An open-source program for linear-scaling electronic structure 00021 * calculations, 00022 * Elias Rudberg, Emanuel H. Rubensson, Pawel Salek, and Anastasia 00023 * Kruchinina, 00024 * SoftwareX 7, 107 (2018), 00025 * <http://dx.doi.org/10.1016/j.softx.2018.03.005> 00026 * 00027 * For further information about Ergo, see <http://www.ergoscf.org>. 00028 */ 00029 00030 /* This file belongs to the template_lapack part of the Ergo source 00031 * code. The source files in the template_lapack directory are modified 00032 * versions of files originally distributed as CLAPACK, see the 00033 * Copyright/license notice in the file template_lapack/COPYING. 00034 */ 00035 00036 00037 #ifndef TEMPLATE_LAPACK_LANST_HEADER 00038 #define TEMPLATE_LAPACK_LANST_HEADER 00039 00040 00041 template<class Treal> 00042 Treal template_lapack_lanst(const char *norm, const integer *n, const Treal *d__, const Treal *e) 00043 { 00044 /* -- LAPACK auxiliary routine (version 3.0) -- 00045 Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 00046 Courant Institute, Argonne National Lab, and Rice University 00047 February 29, 1992 00048 00049 00050 Purpose 00051 ======= 00052 00053 DLANST returns the value of the one norm, or the Frobenius norm, or 00054 the infinity norm, or the element of largest absolute value of a 00055 real symmetric tridiagonal matrix A. 00056 00057 Description 00058 =========== 00059 00060 DLANST returns the value 00061 00062 DLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm' 00063 ( 00064 ( norm1(A), NORM = '1', 'O' or 'o' 00065 ( 00066 ( normI(A), NORM = 'I' or 'i' 00067 ( 00068 ( normF(A), NORM = 'F', 'f', 'E' or 'e' 00069 00070 where norm1 denotes the one norm of a matrix (maximum column sum), 00071 normI denotes the infinity norm of a matrix (maximum row sum) and 00072 normF denotes the Frobenius norm of a matrix (square root of sum of 00073 squares). Note that max(abs(A(i,j))) is not a matrix norm. 00074 00075 Arguments 00076 ========= 00077 00078 NORM (input) CHARACTER*1 00079 Specifies the value to be returned in DLANST as described 00080 above. 00081 00082 N (input) INTEGER 00083 The order of the matrix A. N >= 0. When N = 0, DLANST is 00084 set to zero. 00085 00086 D (input) DOUBLE PRECISION array, dimension (N) 00087 The diagonal elements of A. 00088 00089 E (input) DOUBLE PRECISION array, dimension (N-1) 00090 The (n-1) sub-diagonal or super-diagonal elements of A. 00091 00092 ===================================================================== 00093 00094 00095 Parameter adjustments */ 00096 /* Table of constant values */ 00097 integer c__1 = 1; 00098 00099 /* System generated locals */ 00100 integer i__1; 00101 Treal ret_val, d__1, d__2, d__3, d__4, d__5; 00102 /* Local variables */ 00103 integer i__; 00104 Treal scale; 00105 Treal anorm; 00106 Treal sum; 00107 00108 00109 --e; 00110 --d__; 00111 00112 /* Initialization added by Elias to get rid of compiler warnings. */ 00113 anorm = 0; 00114 /* Function Body */ 00115 if (*n <= 0) { 00116 anorm = 0.; 00117 } else if (template_blas_lsame(norm, "M")) { 00118 00119 /* Find max(abs(A(i,j))). */ 00120 00121 anorm = (d__1 = d__[*n], absMACRO(d__1)); 00122 i__1 = *n - 1; 00123 for (i__ = 1; i__ <= i__1; ++i__) { 00124 /* Computing MAX */ 00125 d__2 = anorm, d__3 = (d__1 = d__[i__], absMACRO(d__1)); 00126 anorm = maxMACRO(d__2,d__3); 00127 /* Computing MAX */ 00128 d__2 = anorm, d__3 = (d__1 = e[i__], absMACRO(d__1)); 00129 anorm = maxMACRO(d__2,d__3); 00130 /* L10: */ 00131 } 00132 } else if (template_blas_lsame(norm, "O") || *(unsigned char *) 00133 norm == '1' || template_blas_lsame(norm, "I")) { 00134 00135 /* Find norm1(A). */ 00136 00137 if (*n == 1) { 00138 anorm = absMACRO(d__[1]); 00139 } else { 00140 /* Computing MAX */ 00141 d__3 = absMACRO(d__[1]) + absMACRO(e[1]), d__4 = (d__1 = e[*n - 1], absMACRO( 00142 d__1)) + (d__2 = d__[*n], absMACRO(d__2)); 00143 anorm = maxMACRO(d__3,d__4); 00144 i__1 = *n - 1; 00145 for (i__ = 2; i__ <= i__1; ++i__) { 00146 /* Computing MAX */ 00147 d__4 = anorm, d__5 = (d__1 = d__[i__], absMACRO(d__1)) + (d__2 = e[ 00148 i__], absMACRO(d__2)) + (d__3 = e[i__ - 1], absMACRO(d__3)); 00149 anorm = maxMACRO(d__4,d__5); 00150 /* L20: */ 00151 } 00152 } 00153 } else if (template_blas_lsame(norm, "F") || template_blas_lsame(norm, "E")) { 00154 00155 /* Find normF(A). */ 00156 00157 scale = 0.; 00158 sum = 1.; 00159 if (*n > 1) { 00160 i__1 = *n - 1; 00161 template_lapack_lassq(&i__1, &e[1], &c__1, &scale, &sum); 00162 sum *= 2; 00163 } 00164 template_lapack_lassq(n, &d__[1], &c__1, &scale, &sum); 00165 anorm = scale * template_blas_sqrt(sum); 00166 } 00167 00168 ret_val = anorm; 00169 return ret_val; 00170 00171 /* End of DLANST */ 00172 00173 } /* dlanst_ */ 00174 00175 #endif