LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
real function sla_gercond ( character  TRANS,
integer  N,
real, dimension( lda, * )  A,
integer  LDA,
real, dimension( ldaf, * )  AF,
integer  LDAF,
integer, dimension( * )  IPIV,
integer  CMODE,
real, dimension( * )  C,
integer  INFO,
real, dimension( * )  WORK,
integer, dimension( * )  IWORK 
)

SLA_GERCOND estimates the Skeel condition number for a general matrix.

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

Purpose: 
    SLA_GERCOND estimates the Skeel condition number of op(A) * op2(C)
    where op2 is determined by CMODE as follows
    CMODE =  1    op2(C) = C
    CMODE =  0    op2(C) = I
    CMODE = -1    op2(C) = inv(C)
    The Skeel condition number cond(A) = norminf( |inv(A)||A| )
    is computed by computing scaling factors R such that
    diag(R)*A*op2(C) is row equilibrated and computing the standard
    infinity-norm condition number.
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 REAL 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 REAL array, dimension (LDAF,N)
     The factors L and U from the factorization
     A = P*L*U as computed by SGETRF.
[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 SGETRF; row i of the matrix was interchanged
     with row IPIV(i).
[in]CMODE
          CMODE is INTEGER
     Determines op2(C) in the formula op(A) * op2(C) as follows:
     CMODE =  1    op2(C) = C
     CMODE =  0    op2(C) = I
     CMODE = -1    op2(C) = inv(C)
[in]C
          C is REAL array, dimension (N)
     The vector C in the formula op(A) * op2(C).
[out]INFO
          INFO is INTEGER
       = 0:  Successful exit.
     i > 0:  The ith argument is invalid.
[in]WORK
          WORK is REAL array, dimension (3*N).
     Workspace.
[in]IWORK
          IWORK is INTEGER array, dimension (N).
     Workspace.2
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 152 of file sla_gercond.f.

152 *
153 * -- LAPACK computational routine (version 3.4.2) --
154 * -- LAPACK is a software package provided by Univ. of Tennessee, --
155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
156 * September 2012
157 *
158 * .. Scalar Arguments ..
159  CHARACTER trans
160  INTEGER n, lda, ldaf, info, cmode
161 * ..
162 * .. Array Arguments ..
163  INTEGER ipiv( * ), iwork( * )
164  REAL a( lda, * ), af( ldaf, * ), work( * ),
165  $ c( * )
166 * ..
167 *
168 * =====================================================================
169 *
170 * .. Local Scalars ..
171  LOGICAL notrans
172  INTEGER kase, i, j
173  REAL ainvnm, tmp
174 * ..
175 * .. Local Arrays ..
176  INTEGER isave( 3 )
177 * ..
178 * .. External Functions ..
179  LOGICAL lsame
180  EXTERNAL lsame
181 * ..
182 * .. External Subroutines ..
183  EXTERNAL slacn2, sgetrs, xerbla
184 * ..
185 * .. Intrinsic Functions ..
186  INTRINSIC abs, max
187 * ..
188 * .. Executable Statements ..
189 *
190  sla_gercond = 0.0
191 *
192  info = 0
193  notrans = lsame( trans, 'N' )
194  IF ( .NOT. notrans .AND. .NOT. lsame(trans, 'T')
195  $ .AND. .NOT. 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( 'SLA_GERCOND', -info )
206  RETURN
207  END IF
208  IF( n.EQ.0 ) THEN
209  sla_gercond = 1.0
210  RETURN
211  END IF
212 *
213 * Compute the equilibration matrix R such that
214 * inv(R)*A*C has unit 1-norm.
215 *
216  IF (notrans) THEN
217  DO i = 1, n
218  tmp = 0.0
219  IF ( cmode .EQ. 1 ) THEN
220  DO j = 1, n
221  tmp = tmp + abs( a( i, j ) * c( j ) )
222  END DO
223  ELSE IF ( cmode .EQ. 0 ) THEN
224  DO j = 1, n
225  tmp = tmp + abs( a( i, j ) )
226  END DO
227  ELSE
228  DO j = 1, n
229  tmp = tmp + abs( a( i, j ) / c( j ) )
230  END DO
231  END IF
232  work( 2*n+i ) = tmp
233  END DO
234  ELSE
235  DO i = 1, n
236  tmp = 0.0
237  IF ( cmode .EQ. 1 ) THEN
238  DO j = 1, n
239  tmp = tmp + abs( a( j, i ) * c( j ) )
240  END DO
241  ELSE IF ( cmode .EQ. 0 ) THEN
242  DO j = 1, n
243  tmp = tmp + abs( a( j, i ) )
244  END DO
245  ELSE
246  DO j = 1, n
247  tmp = tmp + abs( a( j, i ) / c( j ) )
248  END DO
249  END IF
250  work( 2*n+i ) = tmp
251  END DO
252  END IF
253 *
254 * Estimate the norm of inv(op(A)).
255 *
256  ainvnm = 0.0
257 
258  kase = 0
259  10 CONTINUE
260  CALL slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
261  IF( kase.NE.0 ) THEN
262  IF( kase.EQ.2 ) THEN
263 *
264 * Multiply by R.
265 *
266  DO i = 1, n
267  work(i) = work(i) * work(2*n+i)
268  END DO
269 
270  IF (notrans) THEN
271  CALL sgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
272  $ work, n, info )
273  ELSE
274  CALL sgetrs( 'Transpose', n, 1, af, ldaf, ipiv,
275  $ work, n, info )
276  END IF
277 *
278 * Multiply by inv(C).
279 *
280  IF ( cmode .EQ. 1 ) THEN
281  DO i = 1, n
282  work( i ) = work( i ) / c( i )
283  END DO
284  ELSE IF ( cmode .EQ. -1 ) THEN
285  DO i = 1, n
286  work( i ) = work( i ) * c( i )
287  END DO
288  END IF
289  ELSE
290 *
291 * Multiply by inv(C**T).
292 *
293  IF ( cmode .EQ. 1 ) THEN
294  DO i = 1, n
295  work( i ) = work( i ) / c( i )
296  END DO
297  ELSE IF ( cmode .EQ. -1 ) THEN
298  DO i = 1, n
299  work( i ) = work( i ) * c( i )
300  END DO
301  END IF
302 
303  IF (notrans) THEN
304  CALL sgetrs( 'Transpose', n, 1, af, ldaf, ipiv,
305  $ work, n, info )
306  ELSE
307  CALL sgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
308  $ work, n, info )
309  END IF
310 *
311 * Multiply by R.
312 *
313  DO i = 1, n
314  work( i ) = work( i ) * work( 2*n+i )
315  END DO
316  END IF
317  GO TO 10
318  END IF
319 *
320 * Compute the estimate of the reciprocal condition number.
321 *
322  IF( ainvnm .NE. 0.0 )
323  $ sla_gercond = ( 1.0 / ainvnm )
324 *
325  RETURN
326 *
sgetrs
subroutine sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
Definition: sgetrs.f:123
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
sla_gercond
real function sla_gercond(TRANS, N, A, LDA, AF, LDAF, IPIV, CMODE, C, INFO, WORK, IWORK)
SLA_GERCOND estimates the Skeel condition number for a general matrix.
Definition: sla_gercond.f:152
slacn2
subroutine slacn2(N, V, X, ISGN, EST, KASE, ISAVE)
SLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
Definition: slacn2.f:138
lsame
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: