LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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)
Definition cblat2.f:3285
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
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: