SUBROUTINE CPROCP (ND,BD,NM1,BM1,NM2,BM2,NA,AA,X,Y,M,A,B,C,D,U,YY)
C
C CPROCP APPLIES A SEQUENCE OF MATRIX OPERATIONS TO THE VECTOR X AND
C STORES THE RESULT IN Y
C
C BD,BM1,BM2 ARE ARRAYS CONTAINING ROOTS OF CERTIAN B POLYNOMIALS
C ND,NM1,NM2 ARE THE LENGTHS OF THE ARRAYS BD,BM1,BM2 RESPECTIVELY
C AA ARRAY CONTAINING SCALAR MULTIPLIERS OF THE VECTOR X
C NA IS THE LENGTH OF THE ARRAY AA
C X,Y THE MATRIX OPERATIONS ARE APPLIED TO X AND THE RESULT IS Y
C A,B,C ARE ARRAYS WHICH CONTAIN THE TRIDIAGONAL MATRIX
C M IS THE ORDER OF THE MATRIX
C D,U ARE WORK ARRAYS
C ISGN DETERMINES WHETHER OR NOT A CHANGE IN SIGN IS MADE
C
COMPLEX Y ,D ,U ,V ,
1 DEN ,BH ,YM ,AM ,
2 Y1 ,Y2 ,YH ,BD ,
3 CRT ,X ,A ,B ,C
DIMENSION A(1) ,B(1) ,C(1) ,X(1) ,
1 Y(1) ,D(1) ,U(1) ,BD(1) ,
2 BM1(1) ,BM2(1) ,AA(1) ,YY(1)
DO 101 J=1,M
Y(J) = X(J)
101 CONTINUE
MM = M-1
MM2 = M-2
ID = ND
M1 = NM1
M2 = NM2
IA = NA
102 IFLG = 0
IF (ID) 111,111,103
103 CRT = BD(ID)
ID = ID-1
IFLG = 1
C
C BEGIN SOLUTION TO SYSTEM
C
BH = B(M)-CRT
YM = Y(M)
DEN = B(1)-CRT
D(1) = C(1)/DEN
U(1) = A(1)/DEN
Y(1) = Y(1)/DEN
V = C(M)
IF (MM2-2) 106,104,104
104 DO 105 J=2,MM2
DEN = B(J)-CRT-A(J)*D(J-1)
D(J) = C(J)/DEN
U(J) = -A(J)*U(J-1)/DEN
Y(J) = (Y(J)-A(J)*Y(J-1))/DEN
BH = BH-V*U(J-1)
YM = YM-V*Y(J-1)
V = -V*D(J-1)
105 CONTINUE
106 DEN = B(M-1)-CRT-A(M-1)*D(M-2)
D(M-1) = (C(M-1)-A(M-1)*U(M-2))/DEN
Y(M-1) = (Y(M-1)-A(M-1)*Y(M-2))/DEN
AM = A(M)-V*D(M-2)
BH = BH-V*U(M-2)
YM = YM-V*Y(M-2)
DEN = BH-AM*D(M-1)
IF (CABS(DEN)) 107,108,107
107 Y(M) = (YM-AM*Y(M-1))/DEN
GO TO 109
108 Y(M) = (1.,0.)
109 Y(M-1) = Y(M-1)-D(M-1)*Y(M)
DO 110 J=2,MM
K = M-J
Y(K) = Y(K)-D(K)*Y(K+1)-U(K)*Y(M)
110 CONTINUE
111 IF (M1) 112,112,114
112 IF (M2) 123,123,113
113 RT = BM2(M2)
M2 = M2-1
GO TO 119
114 IF (M2) 115,115,116
115 RT = BM1(M1)
M1 = M1-1
GO TO 119
116 IF (ABS(BM1(M1))-ABS(BM2(M2))) 118,118,117
117 RT = BM1(M1)
M1 = M1-1
GO TO 119
118 RT = BM2(M2)
M2 = M2-1
C
C MATRIX MULTIPLICATION
C
119 YH = Y(1)
Y1 = (B(1)-RT)*Y(1)+C(1)*Y(2)+A(1)*Y(M)
IF (MM-2) 122,120,120
120 DO 121 J=2,MM
Y2 = A(J)*Y(J-1)+(B(J)-RT)*Y(J)+C(J)*Y(J+1)
Y(J-1) = Y1
Y1 = Y2
121 CONTINUE
122 Y(M) = A(M)*Y(M-1)+(B(M)-RT)*Y(M)+C(M)*YH
Y(M-1) = Y1
IFLG = 1
GO TO 102
123 IF (IA) 126,126,124
124 RT = AA(IA)
IA = IA-1
IFLG = 1
C
C SCALAR MULTIPLICATION
C
DO 125 J=1,M
Y(J) = RT*Y(J)
125 CONTINUE
126 IF (IFLG) 127,127,102
127 RETURN
END
.