LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ sla_gbrcond()

real function sla_gbrcond ( character  TRANS,
integer  N,
integer  KL,
integer  KU,
real, dimension( ldab, * )  AB,
integer  LDAB,
real, dimension( ldafb, * )  AFB,
integer  LDAFB,
integer, dimension( * )  IPIV,
integer  CMODE,
real, dimension( * )  C,
integer  INFO,
real, dimension( * )  WORK,
integer, dimension( * )  IWORK 
)

SLA_GBRCOND estimates the Skeel condition number for a general banded matrix.

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

Purpose:
    SLA_GBRCOND 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]KL
          KL is INTEGER
     The number of subdiagonals within the band of A.  KL >= 0.
[in]KU
          KU is INTEGER
     The number of superdiagonals within the band of A.  KU >= 0.
[in]AB
          AB is REAL array, dimension (LDAB,N)
     On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
     The j-th column of A is stored in the j-th column of the
     array AB as follows:
     AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
[in]LDAB
          LDAB is INTEGER
     The leading dimension of the array AB.  LDAB >= KL+KU+1.
[in]AFB
          AFB is REAL array, dimension (LDAFB,N)
     Details of the LU factorization of the band matrix A, as
     computed by SGBTRF.  U is stored as an upper triangular
     band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
     and the multipliers used during the factorization are stored
     in rows KL+KU+2 to 2*KL+KU+1.
[in]LDAFB
          LDAFB is INTEGER
     The leading dimension of the array AFB.  LDAFB >= 2*KL+KU+1.
[in]IPIV
          IPIV is INTEGER array, dimension (N)
     The pivot indices from the factorization A = P*L*U
     as computed by SGBTRF; 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 (5*N).
     Workspace.
[out]IWORK
          IWORK is INTEGER array, dimension (N).
     Workspace.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 166 of file sla_gbrcond.f.

168 *
169 * -- LAPACK computational routine --
170 * -- LAPACK is a software package provided by Univ. of Tennessee, --
171 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172 *
173 * .. Scalar Arguments ..
174  CHARACTER TRANS
175  INTEGER N, LDAB, LDAFB, INFO, KL, KU, CMODE
176 * ..
177 * .. Array Arguments ..
178  INTEGER IWORK( * ), IPIV( * )
179  REAL AB( LDAB, * ), AFB( LDAFB, * ), WORK( * ),
180  $ C( * )
181 * ..
182 *
183 * =====================================================================
184 *
185 * .. Local Scalars ..
186  LOGICAL NOTRANS
187  INTEGER KASE, I, J, KD, KE
188  REAL AINVNM, TMP
189 * ..
190 * .. Local Arrays ..
191  INTEGER ISAVE( 3 )
192 * ..
193 * .. External Functions ..
194  LOGICAL LSAME
195  EXTERNAL lsame
196 * ..
197 * .. External Subroutines ..
198  EXTERNAL slacn2, sgbtrs, xerbla
199 * ..
200 * .. Intrinsic Functions ..
201  INTRINSIC abs, max
202 * ..
203 * .. Executable Statements ..
204 *
205  sla_gbrcond = 0.0
206 *
207  info = 0
208  notrans = lsame( trans, 'N' )
209  IF ( .NOT. notrans .AND. .NOT. lsame(trans, 'T')
210  $ .AND. .NOT. lsame(trans, 'C') ) THEN
211  info = -1
212  ELSE IF( n.LT.0 ) THEN
213  info = -2
214  ELSE IF( kl.LT.0 .OR. kl.GT.n-1 ) THEN
215  info = -3
216  ELSE IF( ku.LT.0 .OR. ku.GT.n-1 ) THEN
217  info = -4
218  ELSE IF( ldab.LT.kl+ku+1 ) THEN
219  info = -6
220  ELSE IF( ldafb.LT.2*kl+ku+1 ) THEN
221  info = -8
222  END IF
223  IF( info.NE.0 ) THEN
224  CALL xerbla( 'SLA_GBRCOND', -info )
225  RETURN
226  END IF
227  IF( n.EQ.0 ) THEN
228  sla_gbrcond = 1.0
229  RETURN
230  END IF
231 *
232 * Compute the equilibration matrix R such that
233 * inv(R)*A*C has unit 1-norm.
234 *
235  kd = ku + 1
236  ke = kl + 1
237  IF ( notrans ) THEN
238  DO i = 1, n
239  tmp = 0.0
240  IF ( cmode .EQ. 1 ) THEN
241  DO j = max( i-kl, 1 ), min( i+ku, n )
242  tmp = tmp + abs( ab( kd+i-j, j ) * c( j ) )
243  END DO
244  ELSE IF ( cmode .EQ. 0 ) THEN
245  DO j = max( i-kl, 1 ), min( i+ku, n )
246  tmp = tmp + abs( ab( kd+i-j, j ) )
247  END DO
248  ELSE
249  DO j = max( i-kl, 1 ), min( i+ku, n )
250  tmp = tmp + abs( ab( kd+i-j, j ) / c( j ) )
251  END DO
252  END IF
253  work( 2*n+i ) = tmp
254  END DO
255  ELSE
256  DO i = 1, n
257  tmp = 0.0
258  IF ( cmode .EQ. 1 ) THEN
259  DO j = max( i-kl, 1 ), min( i+ku, n )
260  tmp = tmp + abs( ab( ke-i+j, i ) * c( j ) )
261  END DO
262  ELSE IF ( cmode .EQ. 0 ) THEN
263  DO j = max( i-kl, 1 ), min( i+ku, n )
264  tmp = tmp + abs( ab( ke-i+j, i ) )
265  END DO
266  ELSE
267  DO j = max( i-kl, 1 ), min( i+ku, n )
268  tmp = tmp + abs( ab( ke-i+j, i ) / c( j ) )
269  END DO
270  END IF
271  work( 2*n+i ) = tmp
272  END DO
273  END IF
274 *
275 * Estimate the norm of inv(op(A)).
276 *
277  ainvnm = 0.0
278 
279  kase = 0
280  10 CONTINUE
281  CALL slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
282  IF( kase.NE.0 ) THEN
283  IF( kase.EQ.2 ) THEN
284 *
285 * Multiply by R.
286 *
287  DO i = 1, n
288  work( i ) = work( i ) * work( 2*n+i )
289  END DO
290 
291  IF ( notrans ) THEN
292  CALL sgbtrs( 'No transpose', n, kl, ku, 1, afb, ldafb,
293  $ ipiv, work, n, info )
294  ELSE
295  CALL sgbtrs( 'Transpose', n, kl, ku, 1, afb, ldafb, ipiv,
296  $ work, n, info )
297  END IF
298 *
299 * Multiply by inv(C).
300 *
301  IF ( cmode .EQ. 1 ) THEN
302  DO i = 1, n
303  work( i ) = work( i ) / c( i )
304  END DO
305  ELSE IF ( cmode .EQ. -1 ) THEN
306  DO i = 1, n
307  work( i ) = work( i ) * c( i )
308  END DO
309  END IF
310  ELSE
311 *
312 * Multiply by inv(C**T).
313 *
314  IF ( cmode .EQ. 1 ) THEN
315  DO i = 1, n
316  work( i ) = work( i ) / c( i )
317  END DO
318  ELSE IF ( cmode .EQ. -1 ) THEN
319  DO i = 1, n
320  work( i ) = work( i ) * c( i )
321  END DO
322  END IF
323 
324  IF ( notrans ) THEN
325  CALL sgbtrs( 'Transpose', n, kl, ku, 1, afb, ldafb, ipiv,
326  $ work, n, info )
327  ELSE
328  CALL sgbtrs( 'No transpose', n, kl, ku, 1, afb, ldafb,
329  $ ipiv, work, n, info )
330  END IF
331 *
332 * Multiply by R.
333 *
334  DO i = 1, n
335  work( i ) = work( i ) * work( 2*n+i )
336  END DO
337  END IF
338  GO TO 10
339  END IF
340 *
341 * Compute the estimate of the reciprocal condition number.
342 *
343  IF( ainvnm .NE. 0.0 )
344  $ sla_gbrcond = ( 1.0 / ainvnm )
345 *
346  RETURN
347 *
348 * End of SLA_GBRCOND
349 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
sgbtrs
subroutine sgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
SGBTRS
Definition: sgbtrs.f:138
sla_gbrcond
real function sla_gbrcond(TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB, IPIV, CMODE, C, INFO, WORK, IWORK)
SLA_GBRCOND estimates the Skeel condition number for a general banded matrix.
Definition: sla_gbrcond.f:168
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:136
Here is the call graph for this function:
Here is the caller graph for this function: