LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ 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.
[in]WORK
          WORK is COMPLEX*16 array, dimension (2*N).
     Workspace.
[in]RWORK
          RWORK is DOUBLE PRECISION array, dimension (N).
     Workspace.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 145 of file zla_gercond_c.f.

145 *
146 * -- LAPACK computational routine (version 3.7.0) --
147 * -- LAPACK is a software package provided by Univ. of Tennessee, --
148 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
149 * December 2016
150 *
151 * .. Scalar Aguments ..
152  CHARACTER trans
153  LOGICAL capply
154  INTEGER n, lda, ldaf, info
155 * ..
156 * .. Array Arguments ..
157  INTEGER ipiv( * )
158  COMPLEX*16 a( lda, * ), af( ldaf, * ), work( * )
159  DOUBLE PRECISION c( * ), rwork( * )
160 * ..
161 *
162 * =====================================================================
163 *
164 * .. Local Scalars ..
165  LOGICAL notrans
166  INTEGER kase, i, j
167  DOUBLE PRECISION ainvnm, anorm, tmp
168  COMPLEX*16 zdum
169 * ..
170 * .. Local Arrays ..
171  INTEGER isave( 3 )
172 * ..
173 * .. External Functions ..
174  LOGICAL lsame
175  EXTERNAL lsame
176 * ..
177 * .. External Subroutines ..
178  EXTERNAL zlacn2, zgetrs, xerbla
179 * ..
180 * .. Intrinsic Functions ..
181  INTRINSIC abs, max, REAL, dimag
182 * ..
183 * .. Statement Functions ..
184  DOUBLE PRECISION cabs1
185 * ..
186 * .. Statement Function Definitions ..
187  cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
188 * ..
189 * .. Executable Statements ..
190  zla_gercond_c = 0.0d+0
191 *
192  info = 0
193  notrans = lsame( trans, 'N' )
194  IF ( .NOT. notrans .AND. .NOT. lsame( trans, 'T' ) .AND. .NOT.
195  $ lsame( trans, 'C' ) ) THEN
196  info = -1
197  ELSE IF( n.LT.0 ) THEN
198  info = -2
199  ELSE IF( lda.LT.max( 1, n ) ) THEN
200  info = -4
201  ELSE IF( ldaf.LT.max( 1, n ) ) THEN
202  info = -6
203  END IF
204  IF( info.NE.0 ) THEN
205  CALL xerbla( 'ZLA_GERCOND_C', -info )
206  RETURN
207  END IF
208 *
209 * Compute norm of op(A)*op2(C).
210 *
211  anorm = 0.0d+0
212  IF ( notrans ) THEN
213  DO i = 1, n
214  tmp = 0.0d+0
215  IF ( capply ) THEN
216  DO j = 1, n
217  tmp = tmp + cabs1( a( i, j ) ) / c( j )
218  END DO
219  ELSE
220  DO j = 1, n
221  tmp = tmp + cabs1( a( i, j ) )
222  END DO
223  END IF
224  rwork( i ) = tmp
225  anorm = max( anorm, tmp )
226  END DO
227  ELSE
228  DO i = 1, n
229  tmp = 0.0d+0
230  IF ( capply ) THEN
231  DO j = 1, n
232  tmp = tmp + cabs1( a( j, i ) ) / c( j )
233  END DO
234  ELSE
235  DO j = 1, n
236  tmp = tmp + cabs1( a( j, i ) )
237  END DO
238  END IF
239  rwork( i ) = tmp
240  anorm = max( anorm, tmp )
241  END DO
242  END IF
243 *
244 * Quick return if possible.
245 *
246  IF( n.EQ.0 ) THEN
247  zla_gercond_c = 1.0d+0
248  RETURN
249  ELSE IF( anorm .EQ. 0.0d+0 ) THEN
250  RETURN
251  END IF
252 *
253 * Estimate the norm of inv(op(A)).
254 *
255  ainvnm = 0.0d+0
256 *
257  kase = 0
258  10 CONTINUE
259  CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
260  IF( kase.NE.0 ) THEN
261  IF( kase.EQ.2 ) THEN
262 *
263 * Multiply by R.
264 *
265  DO i = 1, n
266  work( i ) = work( i ) * rwork( i )
267  END DO
268 *
269  IF (notrans) THEN
270  CALL zgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
271  $ work, n, info )
272  ELSE
273  CALL zgetrs( 'Conjugate transpose', n, 1, af, ldaf, ipiv,
274  $ work, n, info )
275  ENDIF
276 *
277 * Multiply by inv(C).
278 *
279  IF ( capply ) THEN
280  DO i = 1, n
281  work( i ) = work( i ) * c( i )
282  END DO
283  END IF
284  ELSE
285 *
286 * Multiply by inv(C**H).
287 *
288  IF ( capply ) THEN
289  DO i = 1, n
290  work( i ) = work( i ) * c( i )
291  END DO
292  END IF
293 *
294  IF ( notrans ) THEN
295  CALL zgetrs( 'Conjugate transpose', n, 1, af, ldaf, ipiv,
296  $ work, n, info )
297  ELSE
298  CALL zgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
299  $ work, n, info )
300  END IF
301 *
302 * Multiply by R.
303 *
304  DO i = 1, n
305  work( i ) = work( i ) * rwork( i )
306  END DO
307  END IF
308  GO TO 10
309  END IF
310 *
311 * Compute the estimate of the reciprocal condition number.
312 *
313  IF( ainvnm .NE. 0.0d+0 )
314  $ zla_gercond_c = 1.0d+0 / ainvnm
315 *
316  RETURN
317 *
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
Definition: zgetrs.f:123
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:135
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
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...
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: