SRC/spbtrs.f

   1 *> \brief \b SPBTRS
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download SPBTRS + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spbtrs.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spbtrs.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spbtrs.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE SPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          UPLO
  25 *       INTEGER            INFO, KD, LDAB, LDB, N, NRHS
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       REAL               AB( LDAB, * ), B( LDB, * )
  29 *       ..
  30 *
  31 *
  32 *> \par Purpose:
  33 *  =============
  34 *>
  35 *> \verbatim
  36 *>
  37 *> SPBTRS solves a system of linear equations A*X = B with a symmetric
  38 *> positive definite band matrix A using the Cholesky factorization
  39 *> A = U**T*U or A = L*L**T computed by SPBTRF.
  40 *> \endverbatim
  41 *
  42 *  Arguments:
  43 *  ==========
  44 *
  45 *> \param[in] UPLO
  46 *> \verbatim
  47 *>          UPLO is CHARACTER*1
  48 *>          = 'U':  Upper triangular factor stored in AB;
  49 *>          = 'L':  Lower triangular factor stored in AB.
  50 *> \endverbatim
  51 *>
  52 *> \param[in] N
  53 *> \verbatim
  54 *>          N is INTEGER
  55 *>          The order of the matrix A.  N >= 0.
  56 *> \endverbatim
  57 *>
  58 *> \param[in] KD
  59 *> \verbatim
  60 *>          KD is INTEGER
  61 *>          The number of superdiagonals of the matrix A if UPLO = 'U',
  62 *>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
  63 *> \endverbatim
  64 *>
  65 *> \param[in] NRHS
  66 *> \verbatim
  67 *>          NRHS is INTEGER
  68 *>          The number of right hand sides, i.e., the number of columns
  69 *>          of the matrix B.  NRHS >= 0.
  70 *> \endverbatim
  71 *>
  72 *> \param[in] AB
  73 *> \verbatim
  74 *>          AB is REAL array, dimension (LDAB,N)
  75 *>          The triangular factor U or L from the Cholesky factorization
  76 *>          A = U**T*U or A = L*L**T of the band matrix A, stored in the
  77 *>          first KD+1 rows of the array.  The j-th column of U or L is
  78 *>          stored in the j-th column of the array AB as follows:
  79 *>          if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
  80 *>          if UPLO ='L', AB(1+i-j,j)    = L(i,j) for j<=i<=min(n,j+kd).
  81 *> \endverbatim
  82 *>
  83 *> \param[in] LDAB
  84 *> \verbatim
  85 *>          LDAB is INTEGER
  86 *>          The leading dimension of the array AB.  LDAB >= KD+1.
  87 *> \endverbatim
  88 *>
  89 *> \param[in,out] B
  90 *> \verbatim
  91 *>          B is REAL array, dimension (LDB,NRHS)
  92 *>          On entry, the right hand side matrix B.
  93 *>          On exit, the solution matrix X.
  94 *> \endverbatim
  95 *>
  96 *> \param[in] LDB
  97 *> \verbatim
  98 *>          LDB is INTEGER
  99 *>          The leading dimension of the array B.  LDB >= max(1,N).
 100 *> \endverbatim
 101 *>
 102 *> \param[out] INFO
 103 *> \verbatim
 104 *>          INFO is INTEGER
 105 *>          = 0:  successful exit
 106 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
 107 *> \endverbatim
 108 *
 109 *  Authors:
 110 *  ========
 111 *
 112 *> \author Univ. of Tennessee
 113 *> \author Univ. of California Berkeley
 114 *> \author Univ. of Colorado Denver
 115 *> \author NAG Ltd.
 116 *
 117 *> \date November 2011
 118 *
 119 *> \ingroup realOTHERcomputational
 120 *
 121 *  =====================================================================
 122       SUBROUTINE SPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
 123 *
 124 *  -- LAPACK computational routine (version 3.4.0) --
 125 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 126 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 127 *     November 2011
 128 *
 129 *     .. Scalar Arguments ..
 130       CHARACTER          UPLO
 131       INTEGER            INFO, KD, LDAB, LDB, N, NRHS
 132 *     ..
 133 *     .. Array Arguments ..
 134       REAL               AB( LDAB, * ), B( LDB, * )
 135 *     ..
 136 *
 137 *  =====================================================================
 138 *
 139 *     .. Local Scalars ..
 140       LOGICAL            UPPER
 141       INTEGER            J
 142 *     ..
 143 *     .. External Functions ..
 144       LOGICAL            LSAME
 145       EXTERNAL           LSAME
 146 *     ..
 147 *     .. External Subroutines ..
 148       EXTERNAL           STBSV, XERBLA
 149 *     ..
 150 *     .. Intrinsic Functions ..
 151       INTRINSIC          MAX
 152 *     ..
 153 *     .. Executable Statements ..
 154 *
 155 *     Test the input parameters.
 156 *
 157       INFO = 0
 158       UPPER = LSAME( UPLO, 'U' )
 159       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
 160          INFO = -1
 161       ELSE IF( N.LT.0 ) THEN
 162          INFO = -2
 163       ELSE IF( KD.LT.0 ) THEN
 164          INFO = -3
 165       ELSE IF( NRHS.LT.0 ) THEN
 166          INFO = -4
 167       ELSE IF( LDAB.LT.KD+1 ) THEN
 168          INFO = -6
 169       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
 170          INFO = -8
 171       END IF
 172       IF( INFO.NE.0 ) THEN
 173          CALL XERBLA( 'SPBTRS', -INFO )
 174          RETURN
 175       END IF
 176 *
 177 *     Quick return if possible
 178 *
 179       IF( N.EQ.0 .OR. NRHS.EQ.0 )
 180      $   RETURN
 181 *
 182       IF( UPPER ) THEN
 183 *
 184 *        Solve A*X = B where A = U**T *U.
 185 *
 186          DO 10 J = 1, NRHS
 187 *
 188 *           Solve U**T *X = B, overwriting B with X.
 189 *
 190             CALL STBSV( 'Upper', 'Transpose', 'Non-unit', N, KD, AB,
 191      $                  LDAB, B( 1, J ), 1 )
 192 *
 193 *           Solve U*X = B, overwriting B with X.
 194 *
 195             CALL STBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, AB,
 196      $                  LDAB, B( 1, J ), 1 )
 197    10    CONTINUE
 198       ELSE
 199 *
 200 *        Solve A*X = B where A = L*L**T.
 201 *
 202          DO 20 J = 1, NRHS
 203 *
 204 *           Solve L*X = B, overwriting B with X.
 205 *
 206             CALL STBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, AB,
 207      $                  LDAB, B( 1, J ), 1 )
 208 *
 209 *           Solve L**T *X = B, overwriting B with X.
 210 *
 211             CALL STBSV( 'Lower', 'Transpose', 'Non-unit', N, KD, AB,
 212      $                  LDAB, B( 1, J ), 1 )
 213    20    CONTINUE
 214       END IF
 215 *
 216       RETURN
 217 *
 218 *     End of SPBTRS
 219 *
 220       END