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