LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ zla_herpvgrw()

 double precision function zla_herpvgrw ( character*1 uplo, integer n, integer info, complex*16, dimension( lda, * ) a, integer lda, complex*16, dimension( ldaf, * ) af, integer ldaf, integer, dimension( * ) ipiv, double precision, dimension( * ) work )

ZLA_HERPVGRW

Purpose:
``` ZLA_HERPVGRW computes the reciprocal pivot growth factor
norm(A)/norm(U). The "max absolute element" norm is used. If this is
much less than 1, the stability of the LU factorization of the
(equilibrated) matrix A could be poor. This also means that the
solution X, estimated condition numbers, and error bounds could be
unreliable.```
Parameters
 [in] UPLO ``` UPLO is CHARACTER*1 = 'U': Upper triangle of A is stored; = 'L': Lower triangle of A is stored.``` [in] N ``` N is INTEGER The number of linear equations, i.e., the order of the matrix A. N >= 0.``` [in] INFO ``` INFO is INTEGER The value of INFO returned from ZHETRF, .i.e., the pivot in column INFO is exactly 0.``` [in] A ``` A is COMPLEX*16 array, dimension (LDA,N) On entry, the N-by-N matrix A.``` [in] LDA ``` LDA is INTEGER The leading dimension of the array A. LDA >= max(1,N).``` [in] AF ``` AF is COMPLEX*16 array, dimension (LDAF,N) The block diagonal matrix D and the multipliers used to obtain the factor U or L as computed by ZHETRF.``` [in] LDAF ``` LDAF is INTEGER The leading dimension of the array AF. LDAF >= max(1,N).``` [in] IPIV ``` IPIV is INTEGER array, dimension (N) Details of the interchanges and the block structure of D as determined by ZHETRF.``` [out] WORK ` WORK is DOUBLE PRECISION array, dimension (2*N)`

Definition at line 121 of file zla_herpvgrw.f.

123*
124* -- LAPACK computational routine --
125* -- LAPACK is a software package provided by Univ. of Tennessee, --
126* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
127*
128* .. Scalar Arguments ..
129 CHARACTER*1 UPLO
130 INTEGER N, INFO, LDA, LDAF
131* ..
132* .. Array Arguments ..
133 INTEGER IPIV( * )
134 COMPLEX*16 A( LDA, * ), AF( LDAF, * )
135 DOUBLE PRECISION WORK( * )
136* ..
137*
138* =====================================================================
139*
140* .. Local Scalars ..
141 INTEGER NCOLS, I, J, K, KP
142 DOUBLE PRECISION AMAX, UMAX, RPVGRW, TMP
143 LOGICAL UPPER, LSAME
144 COMPLEX*16 ZDUM
145* ..
146* .. External Functions ..
147 EXTERNAL lsame
148* ..
149* .. Intrinsic Functions ..
150 INTRINSIC abs, real, dimag, max, min
151* ..
152* .. Statement Functions ..
153 DOUBLE PRECISION CABS1
154* ..
155* .. Statement Function Definitions ..
156 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
157* ..
158* .. Executable Statements ..
159*
160 upper = lsame( 'Upper', uplo )
161 IF ( info.EQ.0 ) THEN
162 IF (upper) THEN
163 ncols = 1
164 ELSE
165 ncols = n
166 END IF
167 ELSE
168 ncols = info
169 END IF
170
171 rpvgrw = 1.0d+0
172 DO i = 1, 2*n
173 work( i ) = 0.0d+0
174 END DO
175*
176* Find the max magnitude entry of each column of A. Compute the max
177* for all N columns so we can apply the pivot permutation while
178* looping below. Assume a full factorization is the common case.
179*
180 IF ( upper ) THEN
181 DO j = 1, n
182 DO i = 1, j
183 work( n+i ) = max( cabs1( a( i,j ) ), work( n+i ) )
184 work( n+j ) = max( cabs1( a( i,j ) ), work( n+j ) )
185 END DO
186 END DO
187 ELSE
188 DO j = 1, n
189 DO i = j, n
190 work( n+i ) = max( cabs1( a( i, j ) ), work( n+i ) )
191 work( n+j ) = max( cabs1( a( i, j ) ), work( n+j ) )
192 END DO
193 END DO
194 END IF
195*
196* Now find the max magnitude entry of each column of U or L. Also
197* permute the magnitudes of A above so they're in the same order as
198* the factor.
199*
200* The iteration orders and permutations were copied from zsytrs.
201* Calls to SSWAP would be severe overkill.
202*
203 IF ( upper ) THEN
204 k = n
205 DO WHILE ( k .LT. ncols .AND. k.GT.0 )
206 IF ( ipiv( k ).GT.0 ) THEN
207! 1x1 pivot
208 kp = ipiv( k )
209 IF ( kp .NE. k ) THEN
210 tmp = work( n+k )
211 work( n+k ) = work( n+kp )
212 work( n+kp ) = tmp
213 END IF
214 DO i = 1, k
215 work( k ) = max( cabs1( af( i, k ) ), work( k ) )
216 END DO
217 k = k - 1
218 ELSE
219! 2x2 pivot
220 kp = -ipiv( k )
221 tmp = work( n+k-1 )
222 work( n+k-1 ) = work( n+kp )
223 work( n+kp ) = tmp
224 DO i = 1, k-1
225 work( k ) = max( cabs1( af( i, k ) ), work( k ) )
226 work( k-1 ) =
227 \$ max( cabs1( af( i, k-1 ) ), work( k-1 ) )
228 END DO
229 work( k ) = max( cabs1( af( k, k ) ), work( k ) )
230 k = k - 2
231 END IF
232 END DO
233 k = ncols
234 DO WHILE ( k .LE. n )
235 IF ( ipiv( k ).GT.0 ) THEN
236 kp = ipiv( k )
237 IF ( kp .NE. k ) THEN
238 tmp = work( n+k )
239 work( n+k ) = work( n+kp )
240 work( n+kp ) = tmp
241 END IF
242 k = k + 1
243 ELSE
244 kp = -ipiv( k )
245 tmp = work( n+k )
246 work( n+k ) = work( n+kp )
247 work( n+kp ) = tmp
248 k = k + 2
249 END IF
250 END DO
251 ELSE
252 k = 1
253 DO WHILE ( k .LE. ncols )
254 IF ( ipiv( k ).GT.0 ) THEN
255! 1x1 pivot
256 kp = ipiv( k )
257 IF ( kp .NE. k ) THEN
258 tmp = work( n+k )
259 work( n+k ) = work( n+kp )
260 work( n+kp ) = tmp
261 END IF
262 DO i = k, n
263 work( k ) = max( cabs1( af( i, k ) ), work( k ) )
264 END DO
265 k = k + 1
266 ELSE
267! 2x2 pivot
268 kp = -ipiv( k )
269 tmp = work( n+k+1 )
270 work( n+k+1 ) = work( n+kp )
271 work( n+kp ) = tmp
272 DO i = k+1, n
273 work( k ) = max( cabs1( af( i, k ) ), work( k ) )
274 work( k+1 ) =
275 \$ max( cabs1( af( i, k+1 ) ) , work( k+1 ) )
276 END DO
277 work(k) = max( cabs1( af( k, k ) ), work( k ) )
278 k = k + 2
279 END IF
280 END DO
281 k = ncols
282 DO WHILE ( k .GE. 1 )
283 IF ( ipiv( k ).GT.0 ) THEN
284 kp = ipiv( k )
285 IF ( kp .NE. k ) THEN
286 tmp = work( n+k )
287 work( n+k ) = work( n+kp )
288 work( n+kp ) = tmp
289 END IF
290 k = k - 1
291 ELSE
292 kp = -ipiv( k )
293 tmp = work( n+k )
294 work( n+k ) = work( n+kp )
295 work( n+kp ) = tmp
296 k = k - 2
297 ENDIF
298 END DO
299 END IF
300*
301* Compute the *inverse* of the max element growth factor. Dividing
302* by zero would imply the largest entry of the factor's column is
303* zero. Than can happen when either the column of A is zero or
304* massive pivots made the factor underflow to zero. Neither counts
305* as growth in itself, so simply ignore terms with zero
306* denominators.
307*
308 IF ( upper ) THEN
309 DO i = ncols, n
310 umax = work( i )
311 amax = work( n+i )
312 IF ( umax /= 0.0d+0 ) THEN
313 rpvgrw = min( amax / umax, rpvgrw )
314 END IF
315 END DO
316 ELSE
317 DO i = 1, ncols
318 umax = work( i )
319 amax = work( n+i )
320 IF ( umax /= 0.0d+0 ) THEN
321 rpvgrw = min( amax / umax, rpvgrw )
322 END IF
323 END DO
324 END IF
325
326 zla_herpvgrw = rpvgrw
327*
328* End of ZLA_HERPVGRW
329*
double precision function zla_herpvgrw(uplo, n, info, a, lda, af, ldaf, ipiv, work)
ZLA_HERPVGRW
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: