LAPACK  3.10.0 LAPACK: Linear Algebra PACKage

## ◆ cla_syrpvgrw()

 real function cla_syrpvgrw ( character*1 UPLO, integer N, integer INFO, complex, dimension( lda, * ) A, integer LDA, complex, dimension( ldaf, * ) AF, integer LDAF, integer, dimension( * ) IPIV, real, dimension( * ) WORK )

CLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite matrix.

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

Purpose:
``` CLA_SYRPVGRW 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 CSYTRF, .i.e., the pivot in column INFO is exactly 0.``` [in] A ``` A is COMPLEX 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 array, dimension (LDAF,N) The block diagonal matrix D and the multipliers used to obtain the factor U or L as computed by CSYTRF.``` [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 CSYTRF.``` [out] WORK ` WORK is REAL array, dimension (2*N)`

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