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

◆ dla_syrpvgrw()

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

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

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

Purpose:
!>
!>
!> DLA_SYRPVGRW computes the reciprocal pivot growth factor
!> norm(A)/norm(U). The  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 DSYTRF, .i.e., the pivot in
!>     column INFO is exactly 0.
!>
[in]A
!>          A is DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (LDAF,N)
!>     The block diagonal matrix D and the multipliers used to
!>     obtain the factor U or L as computed by DSYTRF.
!>
[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 DSYTRF.
!>
[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 118 of file dla_syrpvgrw.f.

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