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

◆ cla_porcond_c()

real function cla_porcond_c ( character uplo,
integer n,
complex, dimension( lda, * ) a,
integer lda,
complex, dimension( ldaf, * ) af,
integer ldaf,
real, dimension( * ) c,
logical capply,
integer info,
complex, dimension( * ) work,
real, dimension( * ) rwork )

CLA_PORCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian positive-definite matrices.

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

Purpose:
!>
!>    CLA_PORCOND_C Computes the infinity norm condition number of
!>    op(A) * inv(diag(C)) where C is a REAL vector
!> 
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]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 triangular factor U or L from the Cholesky factorization
!>     A = U**H*U or A = L*L**H, as computed by CPOTRF.
!> 
[in]LDAF
!>          LDAF is INTEGER
!>     The leading dimension of the array AF.  LDAF >= max(1,N).
!> 
[in]C
!>          C is REAL array, dimension (N)
!>     The vector C in the formula op(A) * inv(diag(C)).
!> 
[in]CAPPLY
!>          CAPPLY is LOGICAL
!>     If .TRUE. then access the vector C in the formula above.
!> 
[out]INFO
!>          INFO is INTEGER
!>       = 0:  Successful exit.
!>     i > 0:  The ith argument is invalid.
!> 
[out]WORK
!>          WORK is COMPLEX array, dimension (2*N).
!>     Workspace.
!> 
[out]RWORK
!>          RWORK is REAL array, dimension (N).
!>     Workspace.
!> 
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 126 of file cla_porcond_c.f.

129*
130* -- LAPACK computational routine --
131* -- LAPACK is a software package provided by Univ. of Tennessee, --
132* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
133*
134* .. Scalar Arguments ..
135 CHARACTER UPLO
136 LOGICAL CAPPLY
137 INTEGER N, LDA, LDAF, INFO
138* ..
139* .. Array Arguments ..
140 COMPLEX A( LDA, * ), AF( LDAF, * ), WORK( * )
141 REAL C( * ), RWORK( * )
142* ..
143*
144* =====================================================================
145*
146* .. Local Scalars ..
147 INTEGER KASE
148 REAL AINVNM, ANORM, TMP
149 INTEGER I, J
150 LOGICAL UP, UPPER
151 COMPLEX ZDUM
152* ..
153* .. Local Arrays ..
154 INTEGER ISAVE( 3 )
155* ..
156* .. External Functions ..
157 LOGICAL LSAME
158 EXTERNAL lsame
159* ..
160* .. External Subroutines ..
161 EXTERNAL clacn2, cpotrs, xerbla
162* ..
163* .. Intrinsic Functions ..
164 INTRINSIC abs, max, real, aimag
165* ..
166* .. Statement Functions ..
167 REAL CABS1
168* ..
169* .. Statement Function Definitions ..
170 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
171* ..
172* .. Executable Statements ..
173*
174 cla_porcond_c = 0.0e+0
175*
176 info = 0
177 upper = lsame( uplo, 'U' )
178 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
179 info = -1
180 ELSE IF( n.LT.0 ) THEN
181 info = -2
182 ELSE IF( lda.LT.max( 1, n ) ) THEN
183 info = -4
184 ELSE IF( ldaf.LT.max( 1, n ) ) THEN
185 info = -6
186 END IF
187 IF( info.NE.0 ) THEN
188 CALL xerbla( 'CLA_PORCOND_C', -info )
189 RETURN
190 END IF
191 up = .false.
192 IF ( lsame( uplo, 'U' ) ) up = .true.
193*
194* Compute norm of op(A)*op2(C).
195*
196 anorm = 0.0e+0
197 IF ( up ) THEN
198 DO i = 1, n
199 tmp = 0.0e+0
200 IF ( capply ) THEN
201 DO j = 1, i
202 tmp = tmp + cabs1( a( j, i ) ) / c( j )
203 END DO
204 DO j = i+1, n
205 tmp = tmp + cabs1( a( i, j ) ) / c( j )
206 END DO
207 ELSE
208 DO j = 1, i
209 tmp = tmp + cabs1( a( j, i ) )
210 END DO
211 DO j = i+1, n
212 tmp = tmp + cabs1( a( i, j ) )
213 END DO
214 END IF
215 rwork( i ) = tmp
216 anorm = max( anorm, tmp )
217 END DO
218 ELSE
219 DO i = 1, n
220 tmp = 0.0e+0
221 IF ( capply ) THEN
222 DO j = 1, i
223 tmp = tmp + cabs1( a( i, j ) ) / c( j )
224 END DO
225 DO j = i+1, n
226 tmp = tmp + cabs1( a( j, i ) ) / c( j )
227 END DO
228 ELSE
229 DO j = 1, i
230 tmp = tmp + cabs1( a( i, j ) )
231 END DO
232 DO j = i+1, n
233 tmp = tmp + cabs1( a( j, i ) )
234 END DO
235 END IF
236 rwork( i ) = tmp
237 anorm = max( anorm, tmp )
238 END DO
239 END IF
240*
241* Quick return if possible.
242*
243 IF( n.EQ.0 ) THEN
244 cla_porcond_c = 1.0e+0
245 RETURN
246 ELSE IF( anorm .EQ. 0.0e+0 ) THEN
247 RETURN
248 END IF
249*
250* Estimate the norm of inv(op(A)).
251*
252 ainvnm = 0.0e+0
253*
254 kase = 0
255 10 CONTINUE
256 CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
257 IF( kase.NE.0 ) THEN
258 IF( kase.EQ.2 ) THEN
259*
260* Multiply by R.
261*
262 DO i = 1, n
263 work( i ) = work( i ) * rwork( i )
264 END DO
265*
266 IF ( up ) THEN
267 CALL cpotrs( 'U', n, 1, af, ldaf,
268 $ work, n, info )
269 ELSE
270 CALL cpotrs( 'L', n, 1, af, ldaf,
271 $ work, n, info )
272 ENDIF
273*
274* Multiply by inv(C).
275*
276 IF ( capply ) THEN
277 DO i = 1, n
278 work( i ) = work( i ) * c( i )
279 END DO
280 END IF
281 ELSE
282*
283* Multiply by inv(C**H).
284*
285 IF ( capply ) THEN
286 DO i = 1, n
287 work( i ) = work( i ) * c( i )
288 END DO
289 END IF
290*
291 IF ( up ) THEN
292 CALL cpotrs( 'U', n, 1, af, ldaf,
293 $ work, n, info )
294 ELSE
295 CALL cpotrs( 'L', n, 1, af, ldaf,
296 $ work, n, info )
297 END IF
298*
299* Multiply by R.
300*
301 DO i = 1, n
302 work( i ) = work( i ) * rwork( i )
303 END DO
304 END IF
305 GO TO 10
306 END IF
307*
308* Compute the estimate of the reciprocal condition number.
309*
310 IF( ainvnm .NE. 0.0e+0 )
311 $ cla_porcond_c = 1.0e+0 / ainvnm
312*
313 RETURN
314*
315* End of CLA_PORCOND_C
316*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
real function cla_porcond_c(uplo, n, a, lda, af, ldaf, c, capply, info, work, rwork)
CLA_PORCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian positiv...
subroutine clacn2(n, v, x, est, kase, isave)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
Definition clacn2.f:131
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
subroutine cpotrs(uplo, n, nrhs, a, lda, b, ldb, info)
CPOTRS
Definition cpotrs.f:108
Here is the call graph for this function:
Here is the caller graph for this function: