1*> \brief \b DPBTRS
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DPBTRS + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpbtrs.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpbtrs.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpbtrs.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE DPBTRS( 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*       DOUBLE PRECISION   AB( LDAB, * ), B( LDB, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> DPBTRS 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 DPBTRF.
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 DOUBLE PRECISION 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 DOUBLE PRECISION 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*> \ingroup doubleOTHERcomputational
118*
119*  =====================================================================
120      SUBROUTINE DPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO )
121*
122*  -- LAPACK computational routine --
123*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
124*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
125*
126*     .. Scalar Arguments ..
127      CHARACTER          UPLO
128      INTEGER            INFO, KD, LDAB, LDB, N, NRHS
129*     ..
130*     .. Array Arguments ..
131      DOUBLE PRECISION   AB( LDAB, * ), B( LDB, * )
132*     ..
133*
134*  =====================================================================
135*
136*     .. Local Scalars ..
137      LOGICAL            UPPER
138      INTEGER            J
139*     ..
140*     .. External Functions ..
141      LOGICAL            LSAME
142      EXTERNAL           LSAME
143*     ..
144*     .. External Subroutines ..
145      EXTERNAL           DTBSV, XERBLA
146*     ..
147*     .. Intrinsic Functions ..
148      INTRINSIC          MAX
149*     ..
150*     .. Executable Statements ..
151*
152*     Test the input parameters.
153*
154      INFO = 0
155      UPPER = LSAME( UPLO, 'U' )
156      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
157         INFO = -1
158      ELSE IF( N.LT.0 ) THEN
159         INFO = -2
160      ELSE IF( KD.LT.0 ) THEN
161         INFO = -3
162      ELSE IF( NRHS.LT.0 ) THEN
163         INFO = -4
164      ELSE IF( LDAB.LT.KD+1 ) THEN
165         INFO = -6
166      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
167         INFO = -8
168      END IF
169      IF( INFO.NE.0 ) THEN
170         CALL XERBLA( 'DPBTRS', -INFO )
171         RETURN
172      END IF
173*
174*     Quick return if possible
175*
176      IF( N.EQ.0 .OR. NRHS.EQ.0 )
177     $   RETURN
178*
179      IF( UPPER ) THEN
180*
181*        Solve A*X = B where A = U**T *U.
182*
183         DO 10 J = 1, NRHS
184*
185*           Solve U**T *X = B, overwriting B with X.
186*
187            CALL DTBSV( 'Upper', 'Transpose', 'Non-unit', N, KD, AB,
188     $                  LDAB, B( 1, J ), 1 )
189*
190*           Solve U*X = B, overwriting B with X.
191*
192            CALL DTBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, AB,
193     $                  LDAB, B( 1, J ), 1 )
194   10    CONTINUE
195      ELSE
196*
197*        Solve A*X = B where A = L*L**T.
198*
199         DO 20 J = 1, NRHS
200*
201*           Solve L*X = B, overwriting B with X.
202*
203            CALL DTBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, AB,
204     $                  LDAB, B( 1, J ), 1 )
205*
206*           Solve L**T *X = B, overwriting B with X.
207*
208            CALL DTBSV( 'Lower', 'Transpose', 'Non-unit', N, KD, AB,
209     $                  LDAB, B( 1, J ), 1 )
210   20    CONTINUE
211      END IF
212*
213      RETURN
214*
215*     End of DPBTRS
216*
217      END
218