ergo
template_lapack_lanst.h
Go to the documentation of this file.
1 /* Ergo, version 3.2, a program for linear scaling electronic structure
2  * calculations.
3  * Copyright (C) 2012 Elias Rudberg, Emanuel H. Rubensson, and Pawel Salek.
4  *
5  * This program is free software: you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation, either version 3 of the License, or
8  * (at your option) any later version.
9  *
10  * This program is distributed in the hope that it will be useful,
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13  * GNU General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with this program. If not, see <http://www.gnu.org/licenses/>.
17  *
18  * Primary academic reference:
19  * Kohn−Sham Density Functional Theory Electronic Structure Calculations
20  * with Linearly Scaling Computational Time and Memory Usage,
21  * Elias Rudberg, Emanuel H. Rubensson, and Pawel Salek,
22  * J. Chem. Theory Comput. 7, 340 (2011),
23  * <http://dx.doi.org/10.1021/ct100611z>
24  *
25  * For further information about Ergo, see <http://www.ergoscf.org>.
26  */
27 
28  /* This file belongs to the template_lapack part of the Ergo source
29  * code. The source files in the template_lapack directory are modified
30  * versions of files originally distributed as CLAPACK, see the
31  * Copyright/license notice in the file template_lapack/COPYING.
32  */
33 
34 
35 #ifndef TEMPLATE_LAPACK_LANST_HEADER
36 #define TEMPLATE_LAPACK_LANST_HEADER
37 
38 
39 template<class Treal>
40 Treal template_lapack_lanst(const char *norm, const integer *n, const Treal *d__, const Treal *e)
41 {
42 /* -- LAPACK auxiliary routine (version 3.0) --
43  Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
44  Courant Institute, Argonne National Lab, and Rice University
45  February 29, 1992
46 
47 
48  Purpose
49  =======
50 
51  DLANST returns the value of the one norm, or the Frobenius norm, or
52  the infinity norm, or the element of largest absolute value of a
53  real symmetric tridiagonal matrix A.
54 
55  Description
56  ===========
57 
58  DLANST returns the value
59 
60  DLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm'
61  (
62  ( norm1(A), NORM = '1', 'O' or 'o'
63  (
64  ( normI(A), NORM = 'I' or 'i'
65  (
66  ( normF(A), NORM = 'F', 'f', 'E' or 'e'
67 
68  where norm1 denotes the one norm of a matrix (maximum column sum),
69  normI denotes the infinity norm of a matrix (maximum row sum) and
70  normF denotes the Frobenius norm of a matrix (square root of sum of
71  squares). Note that max(abs(A(i,j))) is not a matrix norm.
72 
73  Arguments
74  =========
75 
76  NORM (input) CHARACTER*1
77  Specifies the value to be returned in DLANST as described
78  above.
79 
80  N (input) INTEGER
81  The order of the matrix A. N >= 0. When N = 0, DLANST is
82  set to zero.
83 
84  D (input) DOUBLE PRECISION array, dimension (N)
85  The diagonal elements of A.
86 
87  E (input) DOUBLE PRECISION array, dimension (N-1)
88  The (n-1) sub-diagonal or super-diagonal elements of A.
89 
90  =====================================================================
91 
92 
93  Parameter adjustments */
94  /* Table of constant values */
95  integer c__1 = 1;
96 
97  /* System generated locals */
98  integer i__1;
99  Treal ret_val, d__1, d__2, d__3, d__4, d__5;
100  /* Local variables */
101  integer i__;
102  Treal scale;
103  Treal anorm;
104  Treal sum;
105 
106 
107  --e;
108  --d__;
109 
110  /* Initialization added by Elias to get rid of compiler warnings. */
111  anorm = 0;
112  /* Function Body */
113  if (*n <= 0) {
114  anorm = 0.;
115  } else if (template_blas_lsame(norm, "M")) {
116 
117 /* Find max(abs(A(i,j))). */
118 
119  anorm = (d__1 = d__[*n], absMACRO(d__1));
120  i__1 = *n - 1;
121  for (i__ = 1; i__ <= i__1; ++i__) {
122 /* Computing MAX */
123  d__2 = anorm, d__3 = (d__1 = d__[i__], absMACRO(d__1));
124  anorm = maxMACRO(d__2,d__3);
125 /* Computing MAX */
126  d__2 = anorm, d__3 = (d__1 = e[i__], absMACRO(d__1));
127  anorm = maxMACRO(d__2,d__3);
128 /* L10: */
129  }
130  } else if (template_blas_lsame(norm, "O") || *(unsigned char *)
131  norm == '1' || template_blas_lsame(norm, "I")) {
132 
133 /* Find norm1(A). */
134 
135  if (*n == 1) {
136  anorm = absMACRO(d__[1]);
137  } else {
138 /* Computing MAX */
139  d__3 = absMACRO(d__[1]) + absMACRO(e[1]), d__4 = (d__1 = e[*n - 1], absMACRO(
140  d__1)) + (d__2 = d__[*n], absMACRO(d__2));
141  anorm = maxMACRO(d__3,d__4);
142  i__1 = *n - 1;
143  for (i__ = 2; i__ <= i__1; ++i__) {
144 /* Computing MAX */
145  d__4 = anorm, d__5 = (d__1 = d__[i__], absMACRO(d__1)) + (d__2 = e[
146  i__], absMACRO(d__2)) + (d__3 = e[i__ - 1], absMACRO(d__3));
147  anorm = maxMACRO(d__4,d__5);
148 /* L20: */
149  }
150  }
151  } else if (template_blas_lsame(norm, "F") || template_blas_lsame(norm, "E")) {
152 
153 /* Find normF(A). */
154 
155  scale = 0.;
156  sum = 1.;
157  if (*n > 1) {
158  i__1 = *n - 1;
159  template_lapack_lassq(&i__1, &e[1], &c__1, &scale, &sum);
160  sum *= 2;
161  }
162  template_lapack_lassq(n, &d__[1], &c__1, &scale, &sum);
163  anorm = scale * template_blas_sqrt(sum);
164  }
165 
166  ret_val = anorm;
167  return ret_val;
168 
169 /* End of DLANST */
170 
171 } /* dlanst_ */
172 
173 #endif