1 SUBROUTINE PROC (ND, BD, NM1, BM1, NM2, BM2, NA, AA, X, Y, M, A, 2 + B, C, D, W, U) 3C***BEGIN PROLOGUE PROC 4C***SUBSIDIARY 5C***PURPOSE Subsidiary to CBLKTR 6C***LIBRARY SLATEC 7C***TYPE COMPLEX (PROD-S, PROC-C) 8C***AUTHOR (UNKNOWN) 9C***DESCRIPTION 10C 11C PROC applies a sequence of matrix operations to the vector X and 12C stores the result in Y. 13C BD,BM1,BM2 are arrays containing roots of certain B polynomials. 14C ND,NM1,NM2 are the lengths of the arrays BD,BM1,BM2 respectively. 15C AA Array containing scalar multipliers of the vector X. 16C NA is the length of the array AA. 17C X,Y The matrix operations are applied to X and the result is Y. 18C A,B,C are arrays which contain the tridiagonal matrix. 19C M is the order of the matrix. 20C D,W,U are working arrays. 21C IS determines whether or not a change in sign is made. 22C 23C***SEE ALSO CBLKTR 24C***ROUTINES CALLED (NONE) 25C***REVISION HISTORY (YYMMDD) 26C 801001 DATE WRITTEN 27C 890531 Changed all specific intrinsics to generic. (WRB) 28C 891214 Prologue converted to Version 4.0 format. (BAB) 29C 900402 Added TYPE section. (WRB) 30C***END PROLOGUE PROC 31C 32 DIMENSION A(*) ,B(*) ,C(*) ,X(*) , 33 1 Y(*) ,D(*) ,W(*) ,BD(*) , 34 2 BM1(*) ,BM2(*) ,AA(*) ,U(*) 35 COMPLEX X ,Y ,A ,B , 36 1 C ,D ,W ,U , 37 2 DEN 38C***FIRST EXECUTABLE STATEMENT PROC 39 DO 101 J=1,M 40 W(J) = X(J) 41 Y(J) = W(J) 42 101 CONTINUE 43 MM = M-1 44 ID = ND 45 IBR = 0 46 M1 = NM1 47 M2 = NM2 48 IA = NA 49 102 IF (IA) 105,105,103 50 103 RT = AA(IA) 51 IF (ND .EQ. 0) RT = -RT 52 IA = IA-1 53C 54C SCALAR MULTIPLICATION 55C 56 DO 104 J=1,M 57 Y(J) = RT*W(J) 58 104 CONTINUE 59 105 IF (ID) 125,125,106 60 106 RT = BD(ID) 61 ID = ID-1 62 IF (ID .EQ. 0) IBR = 1 63C 64C BEGIN SOLUTION TO SYSTEM 65C 66 D(M) = A(M)/(B(M)-RT) 67 W(M) = Y(M)/(B(M)-RT) 68 DO 107 J=2,MM 69 K = M-J 70 DEN = B(K+1)-RT-C(K+1)*D(K+2) 71 D(K+1) = A(K+1)/DEN 72 W(K+1) = (Y(K+1)-C(K+1)*W(K+2))/DEN 73 107 CONTINUE 74 DEN = B(1)-RT-C(1)*D(2) 75 W(1) = (1.,0.) 76 IF (ABS(DEN)) 108,109,108 77 108 W(1) = (Y(1)-C(1)*W(2))/DEN 78 109 DO 110 J=2,M 79 W(J) = W(J)-D(J)*W(J-1) 80 110 CONTINUE 81 IF (NA) 113,113,102 82 111 DO 112 J=1,M 83 Y(J) = W(J) 84 112 CONTINUE 85 IBR = 1 86 GO TO 102 87 113 IF (M1) 114,114,115 88 114 IF (M2) 111,111,120 89 115 IF (M2) 117,117,116 90 116 IF (ABS(BM1(M1))-ABS(BM2(M2))) 120,120,117 91 117 IF (IBR) 118,118,119 92 118 IF (ABS(BM1(M1)-BD(ID))-ABS(BM1(M1)-RT)) 111,119,119 93 119 RT = RT-BM1(M1) 94 M1 = M1-1 95 GO TO 123 96 120 IF (IBR) 121,121,122 97 121 IF (ABS(BM2(M2)-BD(ID))-ABS(BM2(M2)-RT)) 111,122,122 98 122 RT = RT-BM2(M2) 99 M2 = M2-1 100 123 DO 124 J=1,M 101 Y(J) = Y(J)+RT*W(J) 102 124 CONTINUE 103 GO TO 102 104 125 RETURN 105 END 106