LAPACK  3.8.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.

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
Date
December 2016

Definition at line 152 of file sla_gercond.f.

152 *
153 * -- LAPACK computational routine (version 3.7.0) --
154 * -- LAPACK is a software package provided by Univ. of Tennessee, --
155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
156 * December 2016
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 *
subroutine sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
Definition: sgetrs.f:123
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
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
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
Here is the call graph for this function:
Here is the caller graph for this function: