LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
zla_porpvgrw.f
Go to the documentation of this file.
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 COMPLEX*16 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 September 2012
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.4.2) --
111 * -- LAPACK is a software package provided by Univ. of Tennessee, --
112 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
113 * September 2012
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, zlaset
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