| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273 |
- *DECK CMPTRX
- SUBROUTINE CMPTRX (IDEGBR, IDEGCR, M, A, B, C, Y, TCOS, D, W)
- C***BEGIN PROLOGUE CMPTRX
- C***SUBSIDIARY
- C***PURPOSE Subsidiary to CMGNBN
- C***LIBRARY SLATEC
- C***TYPE COMPLEX (TRIX-S, CMPTRX-C)
- C***AUTHOR (UNKNOWN)
- C***DESCRIPTION
- C
- C Subroutine to solve a system of linear equations where the
- C coefficient matrix is a rational function in the matrix given by
- C tridiagonal ( . . . , A(I), B(I), C(I), . . . ).
- C
- C***SEE ALSO CMGNBN
- C***ROUTINES CALLED (NONE)
- C***REVISION HISTORY (YYMMDD)
- C 801001 DATE WRITTEN
- C 890531 Changed all specific intrinsics to generic. (WRB)
- C 890531 REVISION DATE from Version 3.2
- C 891214 Prologue converted to Version 4.0 format. (BAB)
- C 900402 Added TYPE section. (WRB)
- C***END PROLOGUE CMPTRX
- C
- COMPLEX A ,B ,C ,Y ,
- 1 TCOS ,D ,W ,X ,
- 2 XX ,Z
- DIMENSION A(*) ,B(*) ,C(*) ,Y(*) ,
- 1 TCOS(*) ,D(*) ,W(*)
- INTEGER KB, KC
- C***FIRST EXECUTABLE STATEMENT CMPTRX
- MM1 = M-1
- KB = IDEGBR+1
- KC = IDEGCR+1
- L = KB/KC
- LINT = 1
- DO 108 K=1,IDEGBR
- X = TCOS(K)
- IF (K .NE. L) GO TO 102
- I = IDEGBR+LINT
- XX = X-TCOS(I)
- DO 101 I=1,M
- W(I) = Y(I)
- Y(I) = XX*Y(I)
- 101 CONTINUE
- 102 CONTINUE
- Z = 1./(B(1)-X)
- D(1) = C(1)*Z
- Y(1) = Y(1)*Z
- DO 103 I=2,MM1
- Z = 1./(B(I)-X-A(I)*D(I-1))
- D(I) = C(I)*Z
- Y(I) = (Y(I)-A(I)*Y(I-1))*Z
- 103 CONTINUE
- Z = B(M)-X-A(M)*D(MM1)
- IF (ABS(Z) .NE. 0.) GO TO 104
- Y(M) = (0.,0.)
- GO TO 105
- 104 Y(M) = (Y(M)-A(M)*Y(MM1))/Z
- 105 CONTINUE
- DO 106 IP=1,MM1
- I = M-IP
- Y(I) = Y(I)-D(I)*Y(I+1)
- 106 CONTINUE
- IF (K .NE. L) GO TO 108
- DO 107 I=1,M
- Y(I) = Y(I)+W(I)
- 107 CONTINUE
- LINT = LINT+1
- L = (LINT*KB)/KC
- 108 CONTINUE
- RETURN
- END
|
