1*DECK CPBSL
2      SUBROUTINE CPBSL (ABD, LDA, N, M, B)
3C***BEGIN PROLOGUE  CPBSL
4C***PURPOSE  Solve the complex Hermitian positive definite band system
5C            using the factors computed by CPBCO or CPBFA.
6C***LIBRARY   SLATEC (LINPACK)
7C***CATEGORY  D2D2
8C***TYPE      COMPLEX (SPBSL-S, DPBSL-D, CPBSL-C)
9C***KEYWORDS  BANDED, LINEAR ALGEBRA, LINPACK, MATRIX,
10C             POSITIVE DEFINITE, SOLVE
11C***AUTHOR  Moler, C. B., (U. of New Mexico)
12C***DESCRIPTION
13C
14C     CPBSL solves the complex Hermitian positive definite band
15C     system  A*X = B
16C     using the factors computed by CPBCO or CPBFA.
17C
18C     On Entry
19C
20C        ABD     COMPLEX(LDA, N)
21C                the output from CPBCO or CPBFA.
22C
23C        LDA     INTEGER
24C                the leading dimension of the array  ABD .
25C
26C        N       INTEGER
27C                the order of the matrix  A .
28C
29C        M       INTEGER
30C                the number of diagonals above the main diagonal.
31C
32C        B       COMPLEX(N)
33C                the right hand side vector.
34C
35C     On Return
36C
37C        B       the solution vector  X .
38C
39C     Error Condition
40C
41C        A division by zero will occur if the input factor contains
42C        a zero on the diagonal.  Technically this indicates
43C        singularity but it is usually caused by improper subroutine
44C        arguments.  It will not occur if the subroutines are called
45C        correctly and  INFO .EQ. 0 .
46C
47C     To compute  INVERSE(A) * C  where  C  is a matrix
48C     with  P  columns
49C           CALL CPBCO(ABD,LDA,N,RCOND,Z,INFO)
50C           IF (RCOND is too small .OR. INFO .NE. 0) GO TO ...
51C           DO 10 J = 1, P
52C              CALL CPBSL(ABD,LDA,N,C(1,J))
53C        10 CONTINUE
54C
55C***REFERENCES  J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
56C                 Stewart, LINPACK Users' Guide, SIAM, 1979.
57C***ROUTINES CALLED  CAXPY, CDOTC
58C***REVISION HISTORY  (YYMMDD)
59C   780814  DATE WRITTEN
60C   890531  Changed all specific intrinsics to generic.  (WRB)
61C   890831  Modified array declarations.  (WRB)
62C   890831  REVISION DATE from Version 3.2
63C   891214  Prologue converted to Version 4.0 format.  (BAB)
64C   900326  Removed duplicate information from DESCRIPTION section.
65C           (WRB)
66C   920501  Reformatted the REFERENCES section.  (WRB)
67C***END PROLOGUE  CPBSL
68      INTEGER LDA,N,M
69      COMPLEX ABD(LDA,*),B(*)
70C
71      COMPLEX CDOTC,T
72      INTEGER K,KB,LA,LB,LM
73C
74C     SOLVE CTRANS(R)*Y = B
75C
76C***FIRST EXECUTABLE STATEMENT  CPBSL
77      DO 10 K = 1, N
78         LM = MIN(K-1,M)
79         LA = M + 1 - LM
80         LB = K - LM
81         T = CDOTC(LM,ABD(LA,K),1,B(LB),1)
82         B(K) = (B(K) - T)/ABD(M+1,K)
83   10 CONTINUE
84C
85C     SOLVE R*X = Y
86C
87      DO 20 KB = 1, N
88         K = N + 1 - KB
89         LM = MIN(K-1,M)
90         LA = M + 1 - LM
91         LB = K - LM
92         B(K) = B(K)/ABD(M+1,K)
93         T = -B(K)
94         CALL CAXPY(LM,T,ABD(LA,K),1,B(LB),1)
95   20 CONTINUE
96      RETURN
97      END
98