LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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

Download ZLA_HERPVGRW + dependencies [TGZ] [ZIP] [TXT]

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)
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

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 *
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
double precision function zla_herpvgrw(UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, WORK)
ZLA_HERPVGRW
Definition: zla_herpvgrw.f:123
Here is the call graph for this function:
Here is the caller graph for this function: