LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ cla_gercond_c()

real function cla_gercond_c ( character  TRANS,
integer  N,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( ldaf, * )  AF,
integer  LDAF,
integer, dimension( * )  IPIV,
real, dimension( * )  C,
logical  CAPPLY,
integer  INFO,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK 
)

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

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

Purpose:
    CLA_GERCOND_C computes the infinity norm condition number of
    op(A) * inv(diag(C)) where C is a REAL 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 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 factors L and U from the factorization
     A = P*L*U as computed by CGETRF.
[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 CGETRF; row i of the matrix was interchanged
     with row IPIV(i).
[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.
[in]WORK
          WORK is COMPLEX array, dimension (2*N).
     Workspace.
[in]RWORK
          RWORK is REAL array, dimension (N).
     Workspace.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 144 of file cla_gercond_c.f.

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