LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ sla_gercond()

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.
[out]WORK
          WORK is REAL array, dimension (3*N).
     Workspace.
[out]IWORK
          IWORK is INTEGER array, dimension (N).
     Workspace.2
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 148 of file sla_gercond.f.

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