1*DECK CPBFA
2      SUBROUTINE CPBFA (ABD, LDA, N, M, INFO)
3C***BEGIN PROLOGUE  CPBFA
4C***PURPOSE  Factor a complex Hermitian positive definite matrix stored
5C            in band form.
6C***LIBRARY   SLATEC (LINPACK)
7C***CATEGORY  D2D2
8C***TYPE      COMPLEX (SPBFA-S, DPBFA-D, CPBFA-C)
9C***KEYWORDS  BANDED, LINEAR ALGEBRA, LINPACK, MATRIX FACTORIZATION,
10C             POSITIVE DEFINITE
11C***AUTHOR  Moler, C. B., (U. of New Mexico)
12C***DESCRIPTION
13C
14C     CPBFA factors a complex Hermitian positive definite matrix
15C     stored in band form.
16C
17C     CPBFA is usually called by CPBCO, but it can be called
18C     directly with a saving in time if  RCOND  is not needed.
19C
20C     On Entry
21C
22C        ABD     COMPLEX(LDA, N)
23C                the matrix to be factored.  The columns of the upper
24C                triangle are stored in the columns of ABD and the
25C                diagonals of the upper triangle are stored in the
26C                rows of ABD .  See the comments below for details.
27C
28C        LDA     INTEGER
29C                the leading dimension of the array  ABD .
30C                LDA must be .GE. M + 1 .
31C
32C        N       INTEGER
33C                the order of the matrix  A .
34C
35C        M       INTEGER
36C                the number of diagonals above the main diagonal.
37C                0 .LE. M .LT. N .
38C
39C     On Return
40C
41C        ABD     an upper triangular matrix  R , stored in band
42C                form, so that  A = CTRANS(R)*R .
43C
44C        INFO    INTEGER
45C                = 0  for normal return.
46C                = K  if the leading minor of order  K  is not
47C                     positive definite.
48C
49C     Band Storage
50C
51C           If  A  is a Hermitian positive definite band matrix,
52C           the following program segment will set up the input.
53C
54C                   M = (band width above diagonal)
55C                   DO 20 J = 1, N
56C                      I1 = MAX(1, J-M)
57C                      DO 10 I = I1, J
58C                         K = I-J+M+1
59C                         ABD(K,J) = A(I,J)
60C                10    CONTINUE
61C                20 CONTINUE
62C
63C***REFERENCES  J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
64C                 Stewart, LINPACK Users' Guide, SIAM, 1979.
65C***ROUTINES CALLED  CDOTC
66C***REVISION HISTORY  (YYMMDD)
67C   780814  DATE WRITTEN
68C   890531  Changed all specific intrinsics to generic.  (WRB)
69C   890831  Modified array declarations.  (WRB)
70C   890831  REVISION DATE from Version 3.2
71C   891214  Prologue converted to Version 4.0 format.  (BAB)
72C   900326  Removed duplicate information from DESCRIPTION section.
73C           (WRB)
74C   920501  Reformatted the REFERENCES section.  (WRB)
75C***END PROLOGUE  CPBFA
76      INTEGER LDA,N,M,INFO
77      COMPLEX ABD(LDA,*)
78C
79      COMPLEX CDOTC,T
80      REAL S
81      INTEGER IK,J,JK,K,MU
82C***FIRST EXECUTABLE STATEMENT  CPBFA
83         DO 30 J = 1, N
84            INFO = J
85            S = 0.0E0
86            IK = M + 1
87            JK = MAX(J-M,1)
88            MU = MAX(M+2-J,1)
89            IF (M .LT. MU) GO TO 20
90            DO 10 K = MU, M
91               T = ABD(K,J) - CDOTC(K-MU,ABD(IK,JK),1,ABD(MU,J),1)
92               T = T/ABD(M+1,JK)
93               ABD(K,J) = T
94               S = S + REAL(T*CONJG(T))
95               IK = IK - 1
96               JK = JK + 1
97   10       CONTINUE
98   20       CONTINUE
99            S = REAL(ABD(M+1,J)) - S
100            IF (S .LE. 0.0E0 .OR. AIMAG(ABD(M+1,J)) .NE. 0.0E0)
101     1         GO TO 40
102            ABD(M+1,J) = CMPLX(SQRT(S),0.0E0)
103   30    CONTINUE
104         INFO = 0
105   40 CONTINUE
106      RETURN
107      END
108