sgbcon_8f_source.html

*> \brief \b SGBCON

*

*  =========== DOCUMENTATION ===========

*

* Online html documentation available at

*            http://www.netlib.org/lapack/explore-html/

*

*> \htmlonly

*> Download SGBCON + dependencies

*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbcon.f">

*> [TGZ]</a>

*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbcon.f">

*> [ZIP]</a>

*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbcon.f">

*> [TXT]</a>

*> \endhtmlonly

*

*  Definition:

*  ===========

*

*       SUBROUTINE SGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,

*                          WORK, IWORK, INFO )

*

*       .. Scalar Arguments ..

*       CHARACTER          NORM

*       INTEGER            INFO, KL, KU, LDAB, N

*       REAL               ANORM, RCOND

*       ..

*       .. Array Arguments ..

*       INTEGER            IPIV( * ), IWORK( * )

*       REAL               AB( LDAB, * ), WORK( * )

*       ..

*

*

*> \par Purpose:

*  =============

*>

*> \verbatim

*>

*> SGBCON estimates the reciprocal of the condition number of a real

*> general band matrix A, in either the 1-norm or the infinity-norm,

*> using the LU factorization computed by SGBTRF.

*>

*> An estimate is obtained for norm(inv(A)), and the reciprocal of the

*> condition number is computed as

*>    RCOND = 1 / ( norm(A) * norm(inv(A)) ).

*> \endverbatim

*

*  Arguments:

*  ==========

*

*> \param[in] NORM

*> \verbatim

*>          NORM is CHARACTER*1

*>          Specifies whether the 1-norm condition number or the

*>          infinity-norm condition number is required:

*>          = '1' or 'O':  1-norm;

*>          = 'I':         Infinity-norm.

*> \endverbatim

*>

*> \param[in] N

*> \verbatim

*>          N is INTEGER

*>          The order of the matrix A.  N >= 0.

*> \endverbatim

*>

*> \param[in] KL

*> \verbatim

*>          KL is INTEGER

*>          The number of subdiagonals within the band of A.  KL >= 0.

*> \endverbatim

*>

*> \param[in] KU

*> \verbatim

*>          KU is INTEGER

*>          The number of superdiagonals within the band of A.  KU >= 0.

*> \endverbatim

*>

*> \param[in] AB

*> \verbatim

*>          AB is REAL array, dimension (LDAB,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.

*> \endverbatim

*>

*> \param[in] LDAB

*> \verbatim

*>          LDAB is INTEGER

*>          The leading dimension of the array AB.  LDAB >= 2*KL+KU+1.

*> \endverbatim

*>

*> \param[in] IPIV

*> \verbatim

*>          IPIV is INTEGER array, dimension (N)

*>          The pivot indices; for 1 <= i <= N, row i of the matrix was

*>          interchanged with row IPIV(i).

*> \endverbatim

*>

*> \param[in] ANORM

*> \verbatim

*>          ANORM is REAL

*>          If NORM = '1' or 'O', the 1-norm of the original matrix A.

*>          If NORM = 'I', the infinity-norm of the original matrix A.

*> \endverbatim

*>

*> \param[out] RCOND

*> \verbatim

*>          RCOND is REAL

*>          The reciprocal of the condition number of the matrix A,

*>          computed as RCOND = 1/(norm(A) * norm(inv(A))).

*> \endverbatim

*>

*> \param[out] WORK

*> \verbatim

*>          WORK is REAL array, dimension (3*N)

*> \endverbatim

*>

*> \param[out] IWORK

*> \verbatim

*>          IWORK is INTEGER array, dimension (N)

*> \endverbatim

*>

*> \param[out] INFO

*> \verbatim

*>          INFO is INTEGER

*>          = 0:  successful exit

*>          < 0: if INFO = -i, the i-th argument had an illegal value

*> \endverbatim

*

*  Authors:

*  ========

*

*> \author Univ. of Tennessee

*> \author Univ. of California Berkeley

*> \author Univ. of Colorado Denver

*> \author NAG Ltd.

*

*> \ingroup realGBcomputational

*

*  =====================================================================


      SUBROUTINE sgbcon( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,

     $                   WORK, IWORK, INFO )

*

*  -- LAPACK computational routine --

*  -- LAPACK is a software package provided by Univ. of Tennessee,    --

*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--

*

*     .. Scalar Arguments ..

      CHARACTER          NORM

      INTEGER            INFO, KL, KU, LDAB, N

      REAL               ANORM, RCOND

*     ..

*     .. Array Arguments ..

      INTEGER            IPIV( * ), IWORK( * )

      REAL               AB( LDAB, * ), WORK( * )

*     ..

*

*  =====================================================================

*

*     .. Parameters ..

      REAL               ONE, ZERO

      parameter( one = 1.0e+0, zero = 0.0e+0 )

*     ..

*     .. Local Scalars ..

      LOGICAL            LNOTI, ONENRM

      CHARACTER          NORMIN

      INTEGER            IX, J, JP, KASE, KASE1, KD, LM

      REAL               AINVNM, SCALE, SMLNUM, T

*     ..

*     .. Local Arrays ..

      INTEGER            ISAVE( 3 )

*     ..

*     .. External Functions ..

      LOGICAL            LSAME

      INTEGER            ISAMAX

      REAL               SDOT, SLAMCH

      EXTERNAL           lsame, isamax, sdot, slamch

*     ..

*     .. External Subroutines ..

      EXTERNAL           saxpy, slacn2, slatbs, srscl, xerbla

*     ..

*     .. Intrinsic Functions ..

      INTRINSIC          abs, min

*     ..

*     .. Executable Statements ..

*

*     Test the input parameters.

*

      info = 0

      onenrm = norm.EQ.'1' .OR. lsame( norm, 'O' )

      IF( .NOT.onenrm .AND. .NOT.lsame( norm, 'I' ) ) THEN

         info = -1

      ELSE IF( n.LT.0 ) THEN

         info = -2

      ELSE IF( kl.LT.0 ) THEN

         info = -3

      ELSE IF( ku.LT.0 ) THEN

         info = -4

      ELSE IF( ldab.LT.2*kl+ku+1 ) THEN

         info = -6

      ELSE IF( anorm.LT.zero ) THEN

         info = -8

      END IF

      IF( info.NE.0 ) THEN

         CALL xerbla( 'SGBCON', -info )

         RETURN

      END IF

*

*     Quick return if possible

*

      rcond = zero

      IF( n.EQ.0 ) THEN

         rcond = one

         RETURN

      ELSE IF( anorm.EQ.zero ) THEN

         RETURN

      END IF

*

      smlnum = slamch( 'Safe minimum' )

*

*     Estimate the norm of inv(A).

*

      ainvnm = zero

      normin = 'n'

      IF( ONENRM ) THEN

         KASE1 = 1

      ELSE

         KASE1 = 2

      END IF

      KD = KL + KU + 1

.GT.      LNOTI = KL0

      KASE = 0

   10 CONTINUE

      CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )

.NE.      IF( KASE0 ) THEN

.EQ.         IF( KASEKASE1 ) THEN

*

*           Multiply by inv(L).

*

            IF( LNOTI ) THEN

               DO 20 J = 1, N - 1

                  LM = MIN( KL, N-J )

                  JP = IPIV( J )

                  T = WORK( JP )

.NE.                  IF( JPJ ) THEN

                     WORK( JP ) = WORK( J )

                     WORK( J ) = T

                  END IF

                  CALL SAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), 1 )

   20          CONTINUE

            END IF

*

*           Multiply by inv(U).

*

            CALL SLATBS( 'upper', 'no transpose', 'non-unit', NORMIN, N,

     $                   KL+KU, AB, LDAB, WORK, SCALE, WORK( 2*N+1 ),

     $                   INFO )

         ELSE

*

*           Multiply by inv(U**T).

*

            CALL SLATBS( 'upper', 'transpose', 'non-unit', NORMIN, N,

     $                   KL+KU, AB, LDAB, WORK, SCALE, WORK( 2*N+1 ),

     $                   INFO )

*

*           Multiply by inv(L**T).

*

            IF( LNOTI ) THEN

               DO 30 J = N - 1, 1, -1

                  LM = MIN( KL, N-J )

                  WORK( J ) = WORK( J ) - SDOT( LM, AB( KD+1, J ), 1,

     $                        WORK( J+1 ), 1 )

                  JP = IPIV( J )

.NE.                  IF( JPJ ) THEN

                     T = WORK( JP )

                     WORK( JP ) = WORK( J )

                     WORK( J ) = T

                  END IF

   30          CONTINUE

            END IF

         END IF

*

*        Divide X by 1/SCALE if doing so will not cause overflow.

*

         NORMIN = 'y'

.NE.         IF( SCALEONE ) THEN

            IX = ISAMAX( N, WORK, 1 )

.LT..OR..EQ.            IF( SCALEABS( WORK( IX ) )*SMLNUM  SCALEZERO )

     $         GO TO 40

            CALL SRSCL( N, SCALE, WORK, 1 )

         END IF

         GO TO 10

      END IF

*

*     Compute the estimate of the reciprocal condition number.

*

.NE.      IF( AINVNMZERO )

     $   RCOND = ( ONE / AINVNM ) / ANORM

*

   40 CONTINUE

      RETURN

*

*     End of SGBCON

*


      END

xerbla
subroutine xerbla(srname, info)
XERBLA
Definition xerbla.f:60

sgbcon
subroutine sgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, iwork, info)
SGBCON
Definition sgbcon.f:146

slatbs
subroutine slatbs(uplo, trans, diag, normin, n, kd, ab, ldab, x, scale, cnorm, info)
SLATBS solves a triangular banded system of equations.
Definition slatbs.f:242

srscl
subroutine srscl(n, sa, sx, incx)
SRSCL multiplies a vector by the reciprocal of a real scalar.
Definition srscl.f:84

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

saxpy
subroutine saxpy(n, sa, sx, incx, sy, incy)
SAXPY
Definition saxpy.f:89

min
#define min(a, b)
Definition macros.h:20