LAPACK  3.8.0
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.
[in]WORK
          WORK is REAL array, dimension (2*N)
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 124 of file sla_syrpvgrw.f.

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