| blob | b958c641bc138bcdf73f99b6a4cfbdf33d89b4cb |
1 DOUBLE PRECISION FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK )
2 !
3 ! -- LAPACK auxiliary routine (version 3.1) --
4 ! Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 ! November 2006
6 !
7 ! .. Scalar Arguments ..
8 CHARACTER NORM, UPLO
9 INTEGER LDA, N
10 ! ..
11 ! .. Array Arguments ..
12 DOUBLE PRECISION A( LDA, * ), WORK( * )
13 ! ..
14 !
15 ! Purpose
16 ! =======
17 !
18 ! DLANSY returns the value of the one norm, or the Frobenius norm, or
19 ! the infinity norm, or the element of largest absolute value of a
20 ! real symmetric matrix A.
21 !
22 ! Description
23 ! ===========
24 !
25 ! DLANSY returns the value
26 !
27 ! DLANSY = ( max(abs(A(i,j))), NORM = 'M' or 'm'
28 ! (
29 ! ( norm1(A), NORM = '1', 'O' or 'o'
30 ! (
31 ! ( normI(A), NORM = 'I' or 'i'
32 ! (
33 ! ( normF(A), NORM = 'F', 'f', 'E' or 'e'
34 !
35 ! where norm1 denotes the one norm of a matrix (maximum column sum),
36 ! normI denotes the infinity norm of a matrix (maximum row sum) and
37 ! normF denotes the Frobenius norm of a matrix (square root of sum of
38 ! squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
39 !
40 ! Arguments
41 ! =========
42 !
43 ! NORM (input) CHARACTER*1
44 ! Specifies the value to be returned in DLANSY as described
45 ! above.
46 !
47 ! UPLO (input) CHARACTER*1
48 ! Specifies whether the upper or lower triangular part of the
49 ! symmetric matrix A is to be referenced.
50 ! = 'U': Upper triangular part of A is referenced
51 ! = 'L': Lower triangular part of A is referenced
52 !
53 ! N (input) INTEGER
54 ! The order of the matrix A. N >= 0. When N = 0, DLANSY is
55 ! set to zero.
56 !
57 ! A (input) DOUBLE PRECISION array, dimension (LDA,N)
58 ! The symmetric matrix A. If UPLO = 'U', the leading n by n
59 ! upper triangular part of A contains the upper triangular part
60 ! of the matrix A, and the strictly lower triangular part of A
61 ! is not referenced. If UPLO = 'L', the leading n by n lower
62 ! triangular part of A contains the lower triangular part of
63 ! the matrix A, and the strictly upper triangular part of A is
64 ! not referenced.
65 !
66 ! LDA (input) INTEGER
67 ! The leading dimension of the array A. LDA >= max(N,1).
68 !
69 ! WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
70 ! where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
71 ! WORK is not referenced.
72 !
73 ! =====================================================================
74 !
75 ! .. Parameters ..
76 DOUBLE PRECISION ONE, ZERO
77 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
78 ! ..
79 ! .. Local Scalars ..
80 INTEGER I, J
81 DOUBLE PRECISION ABSA, SCALE, SUM, VALUE
82 ! ..
83 ! .. External Subroutines ..
84 ! EXTERNAL DLASSQ
85 ! ..
86 ! .. External Functions ..
87 ! LOGICAL LSAME
88 ! EXTERNAL LSAME
89 ! ..
90 ! .. Intrinsic Functions ..
91 INTRINSIC ABS, MAX, SQRT
92 ! ..
93 ! .. Executable Statements ..
94 !
95 IF( N.EQ.0 ) THEN
96 VALUE = ZERO
97 ELSE IF( LSAME( NORM, 'M' ) ) THEN
98 !
99 ! Find max(abs(A(i,j))).
100 !
101 VALUE = ZERO
102 IF( LSAME( UPLO, 'U' ) ) THEN
103 DO 20 J = 1, N
104 DO 10 I = 1, J
105 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
106 10 CONTINUE
107 20 CONTINUE
108 ELSE
109 DO 40 J = 1, N
110 DO 30 I = J, N
111 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
112 30 CONTINUE
113 40 CONTINUE
114 END IF
115 ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. &
116 ( NORM.EQ.'1' ) ) THEN
117 !
118 ! Find normI(A) ( = norm1(A), since A is symmetric).
119 !
120 VALUE = ZERO
121 IF( LSAME( UPLO, 'U' ) ) THEN
122 DO 60 J = 1, N
123 SUM = ZERO
124 DO 50 I = 1, J - 1
125 ABSA = ABS( A( I, J ) )
126 SUM = SUM + ABSA
127 WORK( I ) = WORK( I ) + ABSA
128 50 CONTINUE
129 WORK( J ) = SUM + ABS( A( J, J ) )
130 60 CONTINUE
131 DO 70 I = 1, N
132 VALUE = MAX( VALUE, WORK( I ) )
133 70 CONTINUE
134 ELSE
135 DO 80 I = 1, N
136 WORK( I ) = ZERO
137 80 CONTINUE
138 DO 100 J = 1, N
139 SUM = WORK( J ) + ABS( A( J, J ) )
140 DO 90 I = J + 1, N
141 ABSA = ABS( A( I, J ) )
142 SUM = SUM + ABSA
143 WORK( I ) = WORK( I ) + ABSA
144 90 CONTINUE
145 VALUE = MAX( VALUE, SUM )
146 100 CONTINUE
147 END IF
148 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
149 !
150 ! Find normF(A).
151 !
152 SCALE = ZERO
153 SUM = ONE
154 IF( LSAME( UPLO, 'U' ) ) THEN
155 DO 110 J = 2, N
156 CALL DLASSQ( J-1, A( 1, J ), 1, SCALE, SUM )
157 110 CONTINUE
158 ELSE
159 DO 120 J = 1, N - 1
160 CALL DLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM )
161 120 CONTINUE
162 END IF
163 SUM = 2*SUM
164 CALL DLASSQ( N, A, LDA+1, SCALE, SUM )
165 VALUE = SCALE*SQRT( SUM )
166 END IF
167 !
168 DLANSY = VALUE
169 RETURN
170 !
171 ! End of DLANSY
172 !
173 END FUNCTION DLANSY