1: *> \brief \b ZLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix.
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZLA_PORPVGRW + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_porpvgrw.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_porpvgrw.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_porpvgrw.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * DOUBLE PRECISION FUNCTION ZLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF,
22: * LDAF, WORK )
23: *
24: * .. Scalar Arguments ..
25: * CHARACTER*1 UPLO
26: * INTEGER NCOLS, LDA, LDAF
27: * ..
28: * .. Array Arguments ..
29: * COMPLEX*16 A( LDA, * ), AF( LDAF, * )
30: * DOUBLE PRECISION WORK( * )
31: * ..
32: *
33: *
34: *> \par Purpose:
35: * =============
36: *>
37: *> \verbatim
38: *>
39: *>
40: *> ZLA_PORPVGRW computes the reciprocal pivot growth factor
41: *> norm(A)/norm(U). The "max absolute element" norm is used. If this is
42: *> much less than 1, the stability of the LU factorization of the
43: *> (equilibrated) matrix A could be poor. This also means that the
44: *> solution X, estimated condition numbers, and error bounds could be
45: *> unreliable.
46: *> \endverbatim
47: *
48: * Arguments:
49: * ==========
50: *
51: *> \param[in] UPLO
52: *> \verbatim
53: *> UPLO is CHARACTER*1
54: *> = 'U': Upper triangle of A is stored;
55: *> = 'L': Lower triangle of A is stored.
56: *> \endverbatim
57: *>
58: *> \param[in] NCOLS
59: *> \verbatim
60: *> NCOLS is INTEGER
61: *> The number of columns of the matrix A. NCOLS >= 0.
62: *> \endverbatim
63: *>
64: *> \param[in] A
65: *> \verbatim
66: *> A is COMPLEX*16 array, dimension (LDA,N)
67: *> On entry, the N-by-N matrix A.
68: *> \endverbatim
69: *>
70: *> \param[in] LDA
71: *> \verbatim
72: *> LDA is INTEGER
73: *> The leading dimension of the array A. LDA >= max(1,N).
74: *> \endverbatim
75: *>
76: *> \param[in] AF
77: *> \verbatim
78: *> AF is COMPLEX*16 array, dimension (LDAF,N)
79: *> The triangular factor U or L from the Cholesky factorization
80: *> A = U**T*U or A = L*L**T, as computed by ZPOTRF.
81: *> \endverbatim
82: *>
83: *> \param[in] LDAF
84: *> \verbatim
85: *> LDAF is INTEGER
86: *> The leading dimension of the array AF. LDAF >= max(1,N).
87: *> \endverbatim
88: *>
89: *> \param[in] WORK
90: *> \verbatim
91: *> WORK is DOUBLE PRECISION array, dimension (2*N)
92: *> \endverbatim
93: *
94: * Authors:
95: * ========
96: *
97: *> \author Univ. of Tennessee
98: *> \author Univ. of California Berkeley
99: *> \author Univ. of Colorado Denver
100: *> \author NAG Ltd.
101: *
102: *> \date June 2016
103: *
104: *> \ingroup complex16POcomputational
105: *
106: * =====================================================================
107: DOUBLE PRECISION FUNCTION ZLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF,
108: $ LDAF, WORK )
109: *
110: * -- LAPACK computational routine (version 3.7.0) --
111: * -- LAPACK is a software package provided by Univ. of Tennessee, --
112: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
113: * June 2016
114: *
115: * .. Scalar Arguments ..
116: CHARACTER*1 UPLO
117: INTEGER NCOLS, LDA, LDAF
118: * ..
119: * .. Array Arguments ..
120: COMPLEX*16 A( LDA, * ), AF( LDAF, * )
121: DOUBLE PRECISION WORK( * )
122: * ..
123: *
124: * =====================================================================
125: *
126: * .. Local Scalars ..
127: INTEGER I, J
128: DOUBLE PRECISION AMAX, UMAX, RPVGRW
129: LOGICAL UPPER
130: COMPLEX*16 ZDUM
131: * ..
132: * .. External Functions ..
133: EXTERNAL LSAME
134: LOGICAL LSAME
135: * ..
136: * .. Intrinsic Functions ..
137: INTRINSIC ABS, MAX, MIN, REAL, DIMAG
138: * ..
139: * .. Statement Functions ..
140: DOUBLE PRECISION CABS1
141: * ..
142: * .. Statement Function Definitions ..
143: CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
144: * ..
145: * .. Executable Statements ..
146: UPPER = LSAME( 'Upper', UPLO )
147: *
148: * DPOTRF will have factored only the NCOLSxNCOLS leading minor, so
149: * we restrict the growth search to that minor and use only the first
150: * 2*NCOLS workspace entries.
151: *
152: RPVGRW = 1.0D+0
153: DO I = 1, 2*NCOLS
154: WORK( I ) = 0.0D+0
155: END DO
156: *
157: * Find the max magnitude entry of each column.
158: *
159: IF ( UPPER ) THEN
160: DO J = 1, NCOLS
161: DO I = 1, J
162: WORK( NCOLS+J ) =
163: $ MAX( CABS1( A( I, J ) ), WORK( NCOLS+J ) )
164: END DO
165: END DO
166: ELSE
167: DO J = 1, NCOLS
168: DO I = J, NCOLS
169: WORK( NCOLS+J ) =
170: $ MAX( CABS1( A( I, J ) ), WORK( NCOLS+J ) )
171: END DO
172: END DO
173: END IF
174: *
175: * Now find the max magnitude entry of each column of the factor in
176: * AF. No pivoting, so no permutations.
177: *
178: IF ( LSAME( 'Upper', UPLO ) ) THEN
179: DO J = 1, NCOLS
180: DO I = 1, J
181: WORK( J ) = MAX( CABS1( AF( I, J ) ), WORK( J ) )
182: END DO
183: END DO
184: ELSE
185: DO J = 1, NCOLS
186: DO I = J, NCOLS
187: WORK( J ) = MAX( CABS1( AF( I, J ) ), WORK( J ) )
188: END DO
189: END DO
190: END IF
191: *
192: * Compute the *inverse* of the max element growth factor. Dividing
193: * by zero would imply the largest entry of the factor's column is
194: * zero. Than can happen when either the column of A is zero or
195: * massive pivots made the factor underflow to zero. Neither counts
196: * as growth in itself, so simply ignore terms with zero
197: * denominators.
198: *
199: IF ( LSAME( 'Upper', UPLO ) ) THEN
200: DO I = 1, NCOLS
201: UMAX = WORK( I )
202: AMAX = WORK( NCOLS+I )
203: IF ( UMAX /= 0.0D+0 ) THEN
204: RPVGRW = MIN( AMAX / UMAX, RPVGRW )
205: END IF
206: END DO
207: ELSE
208: DO I = 1, NCOLS
209: UMAX = WORK( I )
210: AMAX = WORK( NCOLS+I )
211: IF ( UMAX /= 0.0D+0 ) THEN
212: RPVGRW = MIN( AMAX / UMAX, RPVGRW )
213: END IF
214: END DO
215: END IF
216:
217: ZLA_PORPVGRW = RPVGRW
218: END
CVSweb interface <joel.bertrand@systella.fr>