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

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

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*
cla_syrpvgrw
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
lsame
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: