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

◆ zla_gercond_c()

double precision function zla_gercond_c ( character trans,
integer n,
complex*16, dimension( lda, * ) a,
integer lda,
complex*16, dimension( ldaf, * ) af,
integer ldaf,
integer, dimension( * ) ipiv,
double precision, dimension( * ) c,
logical capply,
integer info,
complex*16, dimension( * ) work,
double precision, dimension( * ) rwork )

ZLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices.

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

Purpose:
!>
!>    ZLA_GERCOND_C computes the infinity norm condition number of
!>    op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector.
!>
Parameters
[in]TRANS
!>          TRANS is CHARACTER*1
!>     Specifies the form of the system of equations:
!>       = 'N':  A * X = B     (No transpose)
!>       = 'T':  A**T * X = B  (Transpose)
!>       = 'C':  A**H * X = B  (Conjugate Transpose = Transpose)
!>
[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*16 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*16 array, dimension (LDAF,N)
!>     The factors L and U from the factorization
!>     A = P*L*U as computed by ZGETRF.
!>
[in]LDAF
!>          LDAF is INTEGER
!>     The leading dimension of the array AF.  LDAF >= max(1,N).
!>
[in]IPIV
!>          IPIV is INTEGER array, dimension (N)
!>     The pivot indices from the factorization A = P*L*U
!>     as computed by ZGETRF; row i of the matrix was interchanged
!>     with row IPIV(i).
!>
[in]C
!>          C is DOUBLE PRECISION 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*16 array, dimension (2*N).
!>     Workspace.
!>
[out]RWORK
!>          RWORK is DOUBLE PRECISION array, dimension (N).
!>     Workspace.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 138 of file zla_gercond_c.f.

141*
142* -- LAPACK computational routine --
143* -- LAPACK is a software package provided by Univ. of Tennessee, --
144* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
145*
146* .. Scalar Arguments ..
147 CHARACTER TRANS
148 LOGICAL CAPPLY
149 INTEGER N, LDA, LDAF, INFO
150* ..
151* .. Array Arguments ..
152 INTEGER IPIV( * )
153 COMPLEX*16 A( LDA, * ), AF( LDAF, * ), WORK( * )
154 DOUBLE PRECISION C( * ), RWORK( * )
155* ..
156*
157* =====================================================================
158*
159* .. Local Scalars ..
160 LOGICAL NOTRANS
161 INTEGER KASE, I, J
162 DOUBLE PRECISION AINVNM, ANORM, TMP
163 COMPLEX*16 ZDUM
164* ..
165* .. Local Arrays ..
166 INTEGER ISAVE( 3 )
167* ..
168* .. External Functions ..
169 LOGICAL LSAME
170 EXTERNAL lsame
171* ..
172* .. External Subroutines ..
173 EXTERNAL zlacn2, zgetrs, xerbla
174* ..
175* .. Intrinsic Functions ..
176 INTRINSIC abs, max, real, dimag
177* ..
178* .. Statement Functions ..
179 DOUBLE PRECISION CABS1
180* ..
181* .. Statement Function Definitions ..
182 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
183* ..
184* .. Executable Statements ..
185 zla_gercond_c = 0.0d+0
186*
187 info = 0
188 notrans = lsame( trans, 'N' )
189 IF ( .NOT. notrans .AND. .NOT. lsame( trans, 'T' ) .AND. .NOT.
190 $ lsame( trans, 'C' ) ) THEN
191 info = -1
192 ELSE IF( n.LT.0 ) THEN
193 info = -2
194 ELSE IF( lda.LT.max( 1, n ) ) THEN
195 info = -4
196 ELSE IF( ldaf.LT.max( 1, n ) ) THEN
197 info = -6
198 END IF
199 IF( info.NE.0 ) THEN
200 CALL xerbla( 'ZLA_GERCOND_C', -info )
201 RETURN
202 END IF
203*
204* Compute norm of op(A)*op2(C).
205*
206 anorm = 0.0d+0
207 IF ( notrans ) THEN
208 DO i = 1, n
209 tmp = 0.0d+0
210 IF ( capply ) THEN
211 DO j = 1, n
212 tmp = tmp + cabs1( a( i, j ) ) / c( j )
213 END DO
214 ELSE
215 DO j = 1, n
216 tmp = tmp + cabs1( a( i, j ) )
217 END DO
218 END IF
219 rwork( i ) = tmp
220 anorm = max( anorm, tmp )
221 END DO
222 ELSE
223 DO i = 1, n
224 tmp = 0.0d+0
225 IF ( capply ) THEN
226 DO j = 1, n
227 tmp = tmp + cabs1( a( j, i ) ) / c( j )
228 END DO
229 ELSE
230 DO j = 1, n
231 tmp = tmp + cabs1( a( j, i ) )
232 END DO
233 END IF
234 rwork( i ) = tmp
235 anorm = max( anorm, tmp )
236 END DO
237 END IF
238*
239* Quick return if possible.
240*
241 IF( n.EQ.0 ) THEN
242 zla_gercond_c = 1.0d+0
243 RETURN
244 ELSE IF( anorm .EQ. 0.0d+0 ) THEN
245 RETURN
246 END IF
247*
248* Estimate the norm of inv(op(A)).
249*
250 ainvnm = 0.0d+0
251*
252 kase = 0
253 10 CONTINUE
254 CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
255 IF( kase.NE.0 ) THEN
256 IF( kase.EQ.2 ) THEN
257*
258* Multiply by R.
259*
260 DO i = 1, n
261 work( i ) = work( i ) * rwork( i )
262 END DO
263*
264 IF (notrans) THEN
265 CALL zgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
266 $ work, n, info )
267 ELSE
268 CALL zgetrs( 'Conjugate transpose', n, 1, af, ldaf,
269 $ ipiv,
270 $ work, n, info )
271 ENDIF
272*
273* Multiply by inv(C).
274*
275 IF ( capply ) THEN
276 DO i = 1, n
277 work( i ) = work( i ) * c( i )
278 END DO
279 END IF
280 ELSE
281*
282* Multiply by inv(C**H).
283*
284 IF ( capply ) THEN
285 DO i = 1, n
286 work( i ) = work( i ) * c( i )
287 END DO
288 END IF
289*
290 IF ( notrans ) THEN
291 CALL zgetrs( 'Conjugate transpose', n, 1, af, ldaf,
292 $ ipiv,
293 $ work, n, info )
294 ELSE
295 CALL zgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
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.0d+0 )
311 $ zla_gercond_c = 1.0d+0 / ainvnm
312*
313 RETURN
314*
315* End of ZLA_GERCOND_C
316*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
zgetrs
subroutine zgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
ZGETRS
Definition zgetrs.f:119
zla_gercond_c
double precision function zla_gercond_c(trans, n, a, lda, af, ldaf, ipiv, c, capply, info, work, rwork)
ZLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices.
Definition zla_gercond_c.f:141
zlacn2
subroutine zlacn2(n, v, x, est, kase, isave)
ZLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
Definition zlacn2.f:131
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: