1 DOUBLE PRECISION FUNCTION ZLA_RPVGRW( N, NCOLS, A, LDA, AF, LDAF )
2 *
3 * -- LAPACK routine (version 3.2.2) --
4 * -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
5 * -- Jason Riedy of Univ. of California Berkeley. --
6 * -- June 2010 --
7 *
8 * -- LAPACK is a software package provided by Univ. of Tennessee, --
9 * -- Univ. of California Berkeley and NAG Ltd. --
10 *
11 IMPLICIT NONE
12 * ..
13 * .. Scalar Arguments ..
14 INTEGER N, NCOLS, LDA, LDAF
15 * ..
16 * .. Array Arguments ..
17 COMPLEX*16 A( LDA, * ), AF( LDAF, * )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * ZLA_RPVGRW computes the reciprocal pivot growth factor
24 * norm(A)/norm(U). The "max absolute element" norm is used. If this is
25 * much less than 1, the stability of the LU factorization of the
26 * (equilibrated) matrix A could be poor. This also means that the
27 * solution X, estimated condition numbers, and error bounds could be
28 * unreliable.
29 *
30 * Arguments
31 * =========
32 *
33 * N (input) INTEGER
34 * The number of linear equations, i.e., the order of the
35 * matrix A. N >= 0.
36 *
37 * NCOLS (input) INTEGER
38 * The number of columns of the matrix A. NCOLS >= 0.
39 *
40 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
41 * On entry, the N-by-N matrix A.
42 *
43 * LDA (input) INTEGER
44 * The leading dimension of the array A. LDA >= max(1,N).
45 *
46 * AF (input) DOUBLE PRECISION array, dimension (LDAF,N)
47 * The factors L and U from the factorization
48 * A = P*L*U as computed by ZGETRF.
49 *
50 * LDAF (input) INTEGER
51 * The leading dimension of the array AF. LDAF >= max(1,N).
52 *
53 * =====================================================================
54 *
55 * .. Local Scalars ..
56 INTEGER I, J
57 DOUBLE PRECISION AMAX, UMAX, RPVGRW
58 COMPLEX*16 ZDUM
59 * ..
60 * .. Intrinsic Functions ..
61 INTRINSIC MAX, MIN, ABS, REAL, DIMAG
62 * ..
63 * .. Statement Functions ..
64 DOUBLE PRECISION CABS1
65 * ..
66 * .. Statement Function Definitions ..
67 CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
68 * ..
69 * .. Executable Statements ..
70 *
71 RPVGRW = 1.0D+0
72
73 DO J = 1, NCOLS
74 AMAX = 0.0D+0
75 UMAX = 0.0D+0
76 DO I = 1, N
77 AMAX = MAX( CABS1( A( I, J ) ), AMAX )
78 END DO
79 DO I = 1, J
80 UMAX = MAX( CABS1( AF( I, J ) ), UMAX )
81 END DO
82 IF ( UMAX /= 0.0D+0 ) THEN
83 RPVGRW = MIN( AMAX / UMAX, RPVGRW )
84 END IF
85 END DO
86 ZLA_RPVGRW = RPVGRW
87 END
2 *
3 * -- LAPACK routine (version 3.2.2) --
4 * -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
5 * -- Jason Riedy of Univ. of California Berkeley. --
6 * -- June 2010 --
7 *
8 * -- LAPACK is a software package provided by Univ. of Tennessee, --
9 * -- Univ. of California Berkeley and NAG Ltd. --
10 *
11 IMPLICIT NONE
12 * ..
13 * .. Scalar Arguments ..
14 INTEGER N, NCOLS, LDA, LDAF
15 * ..
16 * .. Array Arguments ..
17 COMPLEX*16 A( LDA, * ), AF( LDAF, * )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * ZLA_RPVGRW computes the reciprocal pivot growth factor
24 * norm(A)/norm(U). The "max absolute element" norm is used. If this is
25 * much less than 1, the stability of the LU factorization of the
26 * (equilibrated) matrix A could be poor. This also means that the
27 * solution X, estimated condition numbers, and error bounds could be
28 * unreliable.
29 *
30 * Arguments
31 * =========
32 *
33 * N (input) INTEGER
34 * The number of linear equations, i.e., the order of the
35 * matrix A. N >= 0.
36 *
37 * NCOLS (input) INTEGER
38 * The number of columns of the matrix A. NCOLS >= 0.
39 *
40 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
41 * On entry, the N-by-N matrix A.
42 *
43 * LDA (input) INTEGER
44 * The leading dimension of the array A. LDA >= max(1,N).
45 *
46 * AF (input) DOUBLE PRECISION array, dimension (LDAF,N)
47 * The factors L and U from the factorization
48 * A = P*L*U as computed by ZGETRF.
49 *
50 * LDAF (input) INTEGER
51 * The leading dimension of the array AF. LDAF >= max(1,N).
52 *
53 * =====================================================================
54 *
55 * .. Local Scalars ..
56 INTEGER I, J
57 DOUBLE PRECISION AMAX, UMAX, RPVGRW
58 COMPLEX*16 ZDUM
59 * ..
60 * .. Intrinsic Functions ..
61 INTRINSIC MAX, MIN, ABS, REAL, DIMAG
62 * ..
63 * .. Statement Functions ..
64 DOUBLE PRECISION CABS1
65 * ..
66 * .. Statement Function Definitions ..
67 CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
68 * ..
69 * .. Executable Statements ..
70 *
71 RPVGRW = 1.0D+0
72
73 DO J = 1, NCOLS
74 AMAX = 0.0D+0
75 UMAX = 0.0D+0
76 DO I = 1, N
77 AMAX = MAX( CABS1( A( I, J ) ), AMAX )
78 END DO
79 DO I = 1, J
80 UMAX = MAX( CABS1( AF( I, J ) ), UMAX )
81 END DO
82 IF ( UMAX /= 0.0D+0 ) THEN
83 RPVGRW = MIN( AMAX / UMAX, RPVGRW )
84 END IF
85 END DO
86 ZLA_RPVGRW = RPVGRW
87 END