LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
sla_porpvgrw.f
Go to the documentation of this file.
1 *> \brief \b SLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SLA_PORPVGRW + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_porpvgrw.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_porpvgrw.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_porpvgrw.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * REAL FUNCTION SLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, LDAF, WORK )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER*1 UPLO
25 * INTEGER NCOLS, LDA, LDAF
26 * ..
27 * .. Array Arguments ..
28 * REAL A( LDA, * ), AF( LDAF, * ), WORK( * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *>
38 *> SLA_PORPVGRW computes the reciprocal pivot growth factor
39 *> norm(A)/norm(U). The "max absolute element" norm is used. If this is
40 *> much less than 1, the stability of the LU factorization of the
41 *> (equilibrated) matrix A could be poor. This also means that the
42 *> solution X, estimated condition numbers, and error bounds could be
43 *> unreliable.
44 *> \endverbatim
45 *
46 * Arguments:
47 * ==========
48 *
49 *> \param[in] UPLO
50 *> \verbatim
51 *> UPLO is CHARACTER*1
52 *> = 'U': Upper triangle of A is stored;
53 *> = 'L': Lower triangle of A is stored.
54 *> \endverbatim
55 *>
56 *> \param[in] NCOLS
57 *> \verbatim
58 *> NCOLS is INTEGER
59 *> The number of columns of the matrix A. NCOLS >= 0.
60 *> \endverbatim
61 *>
62 *> \param[in] A
63 *> \verbatim
64 *> A is REAL array, dimension (LDA,N)
65 *> On entry, the N-by-N matrix A.
66 *> \endverbatim
67 *>
68 *> \param[in] LDA
69 *> \verbatim
70 *> LDA is INTEGER
71 *> The leading dimension of the array A. LDA >= max(1,N).
72 *> \endverbatim
73 *>
74 *> \param[in] AF
75 *> \verbatim
76 *> AF is REAL array, dimension (LDAF,N)
77 *> The triangular factor U or L from the Cholesky factorization
78 *> A = U**T*U or A = L*L**T, as computed by SPOTRF.
79 *> \endverbatim
80 *>
81 *> \param[in] LDAF
82 *> \verbatim
83 *> LDAF is INTEGER
84 *> The leading dimension of the array AF. LDAF >= max(1,N).
85 *> \endverbatim
86 *>
87 *> \param[out] WORK
88 *> \verbatim
89 *> WORK is REAL array, dimension (2*N)
90 *> \endverbatim
91 *
92 * Authors:
93 * ========
94 *
95 *> \author Univ. of Tennessee
96 *> \author Univ. of California Berkeley
97 *> \author Univ. of Colorado Denver
98 *> \author NAG Ltd.
99 *
100 *> \ingroup realPOcomputational
101 *
102 * =====================================================================
103  REAL function sla_porpvgrw( uplo, ncols, a, lda, af, ldaf, work )
104 *
105 * -- LAPACK computational routine --
106 * -- LAPACK is a software package provided by Univ. of Tennessee, --
107 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
108 *
109 * .. Scalar Arguments ..
110  CHARACTER*1 uplo
111  INTEGER ncols, lda, ldaf
112 * ..
113 * .. Array Arguments ..
114  REAL a( lda, * ), af( ldaf, * ), work( * )
115 * ..
116 *
117 * =====================================================================
118 *
119 * .. Local Scalars ..
120  INTEGER i, j
121  REAL amax, umax, rpvgrw
122  LOGICAL upper
123 * ..
124 * .. Intrinsic Functions ..
125  INTRINSIC abs, max, min
126 * ..
127 * .. External Functions ..
128  EXTERNAL lsame
129  LOGICAL lsame
130 * ..
131 * .. Executable Statements ..
132 *
133  upper = lsame( 'Upper', uplo )
134 *
135 * SPOTRF will have factored only the NCOLSxNCOLS leading minor, so
136 * we restrict the growth search to that minor and use only the first
137 * 2*NCOLS workspace entries.
138 *
139  rpvgrw = 1.0
140  DO i = 1, 2*ncols
141  work( i ) = 0.0
142  END DO
143 *
144 * Find the max magnitude entry of each column.
145 *
146  IF ( upper ) THEN
147  DO j = 1, ncols
148  DO i = 1, j
149  work( ncols+j ) =
150  $ max( abs( a( i, j ) ), work( ncols+j ) )
151  END DO
152  END DO
153  ELSE
154  DO j = 1, ncols
155  DO i = j, ncols
156  work( ncols+j ) =
157  $ max( abs( a( i, j ) ), work( ncols+j ) )
158  END DO
159  END DO
160  END IF
161 *
162 * Now find the max magnitude entry of each column of the factor in
163 * AF. No pivoting, so no permutations.
164 *
165  IF ( lsame( 'Upper', uplo ) ) THEN
166  DO j = 1, ncols
167  DO i = 1, j
168  work( j ) = max( abs( af( i, j ) ), work( j ) )
169  END DO
170  END DO
171  ELSE
172  DO j = 1, ncols
173  DO i = j, ncols
174  work( j ) = max( abs( af( i, j ) ), work( j ) )
175  END DO
176  END DO
177  END IF
178 *
179 * Compute the *inverse* of the max element growth factor. Dividing
180 * by zero would imply the largest entry of the factor's column is
181 * zero. Than can happen when either the column of A is zero or
182 * massive pivots made the factor underflow to zero. Neither counts
183 * as growth in itself, so simply ignore terms with zero
184 * denominators.
185 *
186  IF ( lsame( 'Upper', uplo ) ) THEN
187  DO i = 1, ncols
188  umax = work( i )
189  amax = work( ncols+i )
190  IF ( umax /= 0.0 ) THEN
191  rpvgrw = min( amax / umax, rpvgrw )
192  END IF
193  END DO
194  ELSE
195  DO i = 1, ncols
196  umax = work( i )
197  amax = work( ncols+i )
198  IF ( umax /= 0.0 ) THEN
199  rpvgrw = min( amax / umax, rpvgrw )
200  END IF
201  END DO
202  END IF
203 
204  sla_porpvgrw = rpvgrw
205 *
206 * End of SLA_PORPVGRW
207 *
208  END
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
real function sla_porpvgrw(UPLO, NCOLS, A, LDA, AF, LDAF, WORK)
SLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian...
Definition: sla_porpvgrw.f:104