1*DECK SGTSL
2      SUBROUTINE SGTSL (N, C, D, E, B, INFO)
3C***BEGIN PROLOGUE  SGTSL
4C***PURPOSE  Solve a tridiagonal linear system.
5C***LIBRARY   SLATEC (LINPACK)
6C***CATEGORY  D2A2A
7C***TYPE      SINGLE PRECISION (SGTSL-S, DGTSL-D, CGTSL-C)
8C***KEYWORDS  LINEAR ALGEBRA, LINPACK, MATRIX, SOLVE, TRIDIAGONAL
9C***AUTHOR  Dongarra, J., (ANL)
10C***DESCRIPTION
11C
12C     SGTSL given a general tridiagonal matrix and a right hand
13C     side will find the solution.
14C
15C     On Entry
16C
17C        N       INTEGER
18C                is the order of the tridiagonal matrix.
19C
20C        C       REAL(N)
21C                is the subdiagonal of the tridiagonal matrix.
22C                C(2) through C(N) should contain the subdiagonal.
23C                On output, C is destroyed.
24C
25C        D       REAL(N)
26C                is the diagonal of the tridiagonal matrix.
27C                On output, D is destroyed.
28C
29C        E       REAL(N)
30C                is the superdiagonal of the tridiagonal matrix.
31C                E(1) through E(N-1) should contain the superdiagonal.
32C                On output, E is destroyed.
33C
34C        B       REAL(N)
35C                is the right hand side vector.
36C
37C     On Return
38C
39C        B       is the solution vector.
40C
41C        INFO    INTEGER
42C                = 0 normal value.
43C                = K if the K-th element of the diagonal becomes
44C                    exactly zero.  The subroutine returns when
45C                    this is detected.
46C
47C***REFERENCES  J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
48C                 Stewart, LINPACK Users' Guide, SIAM, 1979.
49C***ROUTINES CALLED  (NONE)
50C***REVISION HISTORY  (YYMMDD)
51C   780814  DATE WRITTEN
52C   890831  Modified array declarations.  (WRB)
53C   890831  REVISION DATE from Version 3.2
54C   891214  Prologue converted to Version 4.0 format.  (BAB)
55C   900326  Removed duplicate information from DESCRIPTION section.
56C           (WRB)
57C   920501  Reformatted the REFERENCES section.  (WRB)
58C***END PROLOGUE  SGTSL
59      INTEGER N,INFO
60      REAL C(*),D(*),E(*),B(*)
61C
62      INTEGER K,KB,KP1,NM1,NM2
63      REAL T
64C***FIRST EXECUTABLE STATEMENT  SGTSL
65         INFO = 0
66         C(1) = D(1)
67         NM1 = N - 1
68         IF (NM1 .LT. 1) GO TO 40
69            D(1) = E(1)
70            E(1) = 0.0E0
71            E(N) = 0.0E0
72C
73            DO 30 K = 1, NM1
74               KP1 = K + 1
75C
76C              FIND THE LARGEST OF THE TWO ROWS
77C
78               IF (ABS(C(KP1)) .LT. ABS(C(K))) GO TO 10
79C
80C                 INTERCHANGE ROW
81C
82                  T = C(KP1)
83                  C(KP1) = C(K)
84                  C(K) = T
85                  T = D(KP1)
86                  D(KP1) = D(K)
87                  D(K) = T
88                  T = E(KP1)
89                  E(KP1) = E(K)
90                  E(K) = T
91                  T = B(KP1)
92                  B(KP1) = B(K)
93                  B(K) = T
94   10          CONTINUE
95C
96C              ZERO ELEMENTS
97C
98               IF (C(K) .NE. 0.0E0) GO TO 20
99                  INFO = K
100                  GO TO 100
101   20          CONTINUE
102               T = -C(KP1)/C(K)
103               C(KP1) = D(KP1) + T*D(K)
104               D(KP1) = E(KP1) + T*E(K)
105               E(KP1) = 0.0E0
106               B(KP1) = B(KP1) + T*B(K)
107   30       CONTINUE
108   40    CONTINUE
109         IF (C(N) .NE. 0.0E0) GO TO 50
110            INFO = N
111         GO TO 90
112   50    CONTINUE
113C
114C           BACK SOLVE
115C
116            NM2 = N - 2
117            B(N) = B(N)/C(N)
118            IF (N .EQ. 1) GO TO 80
119               B(NM1) = (B(NM1) - D(NM1)*B(N))/C(NM1)
120               IF (NM2 .LT. 1) GO TO 70
121               DO 60 KB = 1, NM2
122                  K = NM2 - KB + 1
123                  B(K) = (B(K) - D(K)*B(K+1) - E(K)*B(K+2))/C(K)
124   60          CONTINUE
125   70          CONTINUE
126   80       CONTINUE
127   90    CONTINUE
128  100 CONTINUE
129C
130      RETURN
131      END
132