LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ sla_syrpvgrw()

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

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

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

Purpose:
 SLA_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 SSYTRF, .i.e., the pivot in
     column INFO is exactly 0.
[in]A
          A is REAL 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 REAL array, dimension (LDAF,N)
     The block diagonal matrix D and the multipliers used to
     obtain the factor U or L as computed by SSYTRF.
[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 SSYTRF.
[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 120 of file sla_syrpvgrw.f.

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