GNU Octave  4.0.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
xclange.f
Go to the documentation of this file.
1 *** This subroutine includes all of the CLANGE function instead of
2 *** simply wrapping it in a subroutine to avoid possible differences in
3 *** the way complex values are returned by various Fortran compilers.
4 *** For example, if we simply wrap the function and compile this file
5 *** with gfortran and the library that provides CLANGE is compiled with
6 *** a compiler that uses the g77 (f2c-compatible) calling convention for
7 *** complex-valued functions, all hell will break loose.
8 
9  SUBROUTINE xclange ( NORM, M, N, A, LDA, WORK, VALUE )
10 
11 *** DOUBLE PRECISION FUNCTION CLANGE( NORM, M, N, A, LDA, WORK )
12 *
13 * -- LAPACK auxiliary routine (version 3.1) --
14 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
15 * November 2006
16 *
17 * .. Scalar Arguments ..
18  CHARACTER NORM
19  INTEGER LDA, M, N
20 * ..
21 * .. Array Arguments ..
22  DOUBLE PRECISION WORK( * )
23  COMPLEX*16 A( lda, * )
24 * ..
25 *
26 * Purpose
27 * =======
28 *
29 * CLANGE returns the value of the one norm, or the Frobenius norm, or
30 * the infinity norm, or the element of largest absolute value of a
31 * complex matrix A.
32 *
33 * Description
34 * ===========
35 *
36 * CLANGE returns the value
37 *
38 * CLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
39 * (
40 * ( norm1(A), NORM = '1', 'O' or 'o'
41 * (
42 * ( normI(A), NORM = 'I' or 'i'
43 * (
44 * ( normF(A), NORM = 'F', 'f', 'E' or 'e'
45 *
46 * where norm1 denotes the one norm of a matrix (maximum column sum),
47 * normI denotes the infinity norm of a matrix (maximum row sum) and
48 * normF denotes the Frobenius norm of a matrix (square root of sum of
49 * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
50 *
51 * Arguments
52 * =========
53 *
54 * NORM (input) CHARACTER*1
55 * Specifies the value to be returned in CLANGE as described
56 * above.
57 *
58 * M (input) INTEGER
59 * The number of rows of the matrix A. M >= 0. When M = 0,
60 * CLANGE is set to zero.
61 *
62 * N (input) INTEGER
63 * The number of columns of the matrix A. N >= 0. When N = 0,
64 * CLANGE is set to zero.
65 *
66 * A (input) COMPLEX*16 array, dimension (LDA,N)
67 * The m by n matrix A.
68 *
69 * LDA (input) INTEGER
70 * The leading dimension of the array A. LDA >= max(M,1).
71 *
72 * WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
73 * where LWORK >= M when NORM = 'I'; otherwise, WORK is not
74 * referenced.
75 *
76 * =====================================================================
77 *
78 * .. Parameters ..
79  DOUBLE PRECISION ONE, ZERO
80  parameter( one = 1.0d+0, zero = 0.0d+0 )
81 * ..
82 * .. Local Scalars ..
83  INTEGER I, J
84  DOUBLE PRECISION SCALE, SUM, VALUE
85 * ..
86 * .. External Functions ..
87  LOGICAL LSAME
88  EXTERNAL lsame
89 * ..
90 * .. External Subroutines ..
91  EXTERNAL classq
92 * ..
93 * .. Intrinsic Functions ..
94  INTRINSIC abs, max, min, sqrt
95 * ..
96 * .. Executable Statements ..
97 *
98  IF( min( m, n ).EQ.0 ) THEN
99  VALUE = zero
100  ELSE IF( lsame( norm, 'M' ) ) THEN
101 *
102 * Find max(abs(A(i,j))).
103 *
104  VALUE = zero
105  DO 20 j = 1, n
106  DO 10 i = 1, m
107  VALUE = max( VALUE, abs( a( i, j ) ) )
108  10 CONTINUE
109  20 CONTINUE
110  ELSE IF( ( lsame( norm, 'O' ) ) .OR. ( norm.EQ.'1' ) ) THEN
111 *
112 * Find norm1(A).
113 *
114  VALUE = zero
115  DO 40 j = 1, n
116  sum = zero
117  DO 30 i = 1, m
118  sum = sum + abs( a( i, j ) )
119  30 CONTINUE
120  VALUE = max( VALUE, sum )
121  40 CONTINUE
122  ELSE IF( lsame( norm, 'I' ) ) THEN
123 *
124 * Find normI(A).
125 *
126  DO 50 i = 1, m
127  work( i ) = zero
128  50 CONTINUE
129  DO 70 j = 1, n
130  DO 60 i = 1, m
131  work( i ) = work( i ) + abs( a( i, j ) )
132  60 CONTINUE
133  70 CONTINUE
134  VALUE = zero
135  DO 80 i = 1, m
136  VALUE = max( VALUE, work( i ) )
137  80 CONTINUE
138  ELSE IF( ( lsame( norm, 'F' ) ) .OR. ( lsame( norm, 'E' ) ) ) THEN
139 *
140 * Find normF(A).
141 *
142  scale = zero
143  sum = one
144  DO 90 j = 1, n
145  CALL classq( m, a( 1, j ), 1, scale, sum )
146  90 CONTINUE
147  VALUE = scale*sqrt( sum )
148  END IF
149 *
150 *** CLANGE = VALUE
151  RETURN
152 *
153 * End of CLANGE
154 *
155  END
subroutine xclange(NORM, M, N, A, LDA, WORK, VALUE)
Definition: xclange.f:9
charNDArray max(char d, const charNDArray &m)
Definition: chNDArray.cc:233
T abs(T x)
Definition: pr-output.cc:3062
octave_value sqrt(void) const
Definition: ov.h:1200
charNDArray min(char d, const charNDArray &m)
Definition: chNDArray.cc:210