1      SUBROUTINE STRSVF ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
2*     .. Scalar Arguments ..
3      INTEGER            INCX, LDA, N
4      CHARACTER*1        DIAG, TRANS, UPLO
5*     .. Array Arguments ..
6      REAL               A( LDA, * ), X( * )
7*     ..
8*
9*  Purpose
10*  =======
11*
12*  STRSV  solves one of the systems of equations
13*
14*     A*x = b,   or   A'*x = b,
15*
16*  where b and x are n element vectors and A is an n by n unit, or
17*  non-unit, upper or lower triangular matrix.
18*
19*  No test for singularity or near-singularity is included in this
20*  routine. Such tests must be performed before calling this routine.
21*
22*  Parameters
23*  ==========
24*
25*  UPLO   - CHARACTER*1.
26*           On entry, UPLO specifies whether the matrix is an upper or
27*           lower triangular matrix as follows:
28*
29*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
30*
31*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
32*
33*           Unchanged on exit.
34*
35*  TRANS  - CHARACTER*1.
36*           On entry, TRANS specifies the equations to be solved as
37*           follows:
38*
39*              TRANS = 'N' or 'n'   A*x = b.
40*
41*              TRANS = 'T' or 't'   A'*x = b.
42*
43*              TRANS = 'C' or 'c'   A'*x = b.
44*
45*           Unchanged on exit.
46*
47*  DIAG   - CHARACTER*1.
48*           On entry, DIAG specifies whether or not A is unit
49*           triangular as follows:
50*
51*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
52*
53*              DIAG = 'N' or 'n'   A is not assumed to be unit
54*                                  triangular.
55*
56*           Unchanged on exit.
57*
58*  N      - INTEGER.
59*           On entry, N specifies the order of the matrix A.
60*           N must be at least zero.
61*           Unchanged on exit.
62*
63*  A      - REAL             array of DIMENSION ( LDA, n ).
64*           Before entry with  UPLO = 'U' or 'u', the leading n by n
65*           upper triangular part of the array A must contain the upper
66*           triangular matrix and the strictly lower triangular part of
67*           A is not referenced.
68*           Before entry with UPLO = 'L' or 'l', the leading n by n
69*           lower triangular part of the array A must contain the lower
70*           triangular matrix and the strictly upper triangular part of
71*           A is not referenced.
72*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
73*           A are not referenced either, but are assumed to be unity.
74*           Unchanged on exit.
75*
76*  LDA    - INTEGER.
77*           On entry, LDA specifies the first dimension of A as declared
78*           in the calling (sub) program. LDA must be at least
79*           max( 1, n ).
80*           Unchanged on exit.
81*
82*  X      - REAL             array of dimension at least
83*           ( 1 + ( n - 1 )*abs( INCX ) ).
84*           Before entry, the incremented array X must contain the n
85*           element right-hand side vector b. On exit, X is overwritten
86*           with the solution vector x.
87*
88*  INCX   - INTEGER.
89*           On entry, INCX specifies the increment for the elements of
90*           X. INCX must not be zero.
91*           Unchanged on exit.
92*
93*
94*  Level 2 Blas routine.
95*
96*  -- Written on 22-October-1986.
97*     Jack Dongarra, Argonne National Lab.
98*     Jeremy Du Croz, Nag Central Office.
99*     Sven Hammarling, Nag Central Office.
100*     Richard Hanson, Sandia National Labs.
101*
102*
103*     .. Parameters ..
104      REAL               ZERO
105      PARAMETER        ( ZERO = 0.0E+0 )
106*     .. Local Scalars ..
107      REAL               TEMP
108      INTEGER            I, INFO, IX, J, JX, KX
109      LOGICAL            NOUNIT
110*     .. External Functions ..
111      LOGICAL            LSAME
112      EXTERNAL           LSAME
113*     .. External Subroutines ..
114      EXTERNAL           XERBLA
115*     .. Intrinsic Functions ..
116      INTRINSIC          MAX
117*     ..
118*     .. Executable Statements ..
119*
120*     Test the input parameters.
121*
122      INFO = 0
123      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
124     $         .NOT.LSAME( UPLO , 'L' )      )THEN
125         INFO = 1
126      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
127     $         .NOT.LSAME( TRANS, 'T' ).AND.
128     $         .NOT.LSAME( TRANS, 'C' )      )THEN
129         INFO = 2
130      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
131     $         .NOT.LSAME( DIAG , 'N' )      )THEN
132         INFO = 3
133      ELSE IF( N.LT.0 )THEN
134         INFO = 4
135      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
136         INFO = 6
137      ELSE IF( INCX.EQ.0 )THEN
138         INFO = 8
139      END IF
140      IF( INFO.NE.0 )THEN
141         CALL XERBLA( 'STRSV ', INFO )
142         RETURN
143      END IF
144*
145*     Quick return if possible.
146*
147      IF( N.EQ.0 )
148     $   RETURN
149*
150      NOUNIT = LSAME( DIAG, 'N' )
151*
152*     Set up the start point in X if the increment is not unity. This
153*     will be  ( N - 1 )*INCX  too small for descending loops.
154*
155      IF( INCX.LE.0 )THEN
156         KX = 1 - ( N - 1 )*INCX
157      ELSE IF( INCX.NE.1 )THEN
158         KX = 1
159      END IF
160*
161*     Start the operations. In this version the elements of A are
162*     accessed sequentially with one pass through A.
163*
164      IF( LSAME( TRANS, 'N' ) )THEN
165*
166*        Form  x := inv( A )*x.
167*
168         IF( LSAME( UPLO, 'U' ) )THEN
169            IF( INCX.EQ.1 )THEN
170               DO 20, J = N, 1, -1
171                  IF( X( J ).NE.ZERO )THEN
172                     IF( NOUNIT )
173     $                  X( J ) = X( J )/A( J, J )
174                     TEMP = X( J )
175                     DO 10, I = J - 1, 1, -1
176                        X( I ) = X( I ) - TEMP*A( I, J )
177   10                CONTINUE
178                  END IF
179   20          CONTINUE
180            ELSE
181               JX = KX + ( N - 1 )*INCX
182               DO 40, J = N, 1, -1
183                  IF( X( JX ).NE.ZERO )THEN
184                     IF( NOUNIT )
185     $                  X( JX ) = X( JX )/A( J, J )
186                     TEMP = X( JX )
187                     IX   = JX
188                     DO 30, I = J - 1, 1, -1
189                        IX      = IX      - INCX
190                        X( IX ) = X( IX ) - TEMP*A( I, J )
191   30                CONTINUE
192                  END IF
193                  JX = JX - INCX
194   40          CONTINUE
195            END IF
196         ELSE
197            IF( INCX.EQ.1 )THEN
198               DO 60, J = 1, N
199                  IF( X( J ).NE.ZERO )THEN
200                     IF( NOUNIT )
201     $                  X( J ) = X( J )/A( J, J )
202                     TEMP = X( J )
203                     DO 50, I = J + 1, N
204                        X( I ) = X( I ) - TEMP*A( I, J )
205   50                CONTINUE
206                  END IF
207   60          CONTINUE
208            ELSE
209               JX = KX
210               DO 80, J = 1, N
211                  IF( X( JX ).NE.ZERO )THEN
212                     IF( NOUNIT )
213     $                  X( JX ) = X( JX )/A( J, J )
214                     TEMP = X( JX )
215                     IX   = JX
216                     DO 70, I = J + 1, N
217                        IX      = IX      + INCX
218                        X( IX ) = X( IX ) - TEMP*A( I, J )
219   70                CONTINUE
220                  END IF
221                  JX = JX + INCX
222   80          CONTINUE
223            END IF
224         END IF
225      ELSE
226*
227*        Form  x := inv( A' )*x.
228*
229         IF( LSAME( UPLO, 'U' ) )THEN
230            IF( INCX.EQ.1 )THEN
231               DO 100, J = 1, N
232                  TEMP = X( J )
233                  DO 90, I = 1, J - 1
234                     TEMP = TEMP - A( I, J )*X( I )
235   90             CONTINUE
236                  IF( NOUNIT )
237     $               TEMP = TEMP/A( J, J )
238                  X( J ) = TEMP
239  100          CONTINUE
240            ELSE
241               JX = KX
242               DO 120, J = 1, N
243                  TEMP = X( JX )
244                  IX   = KX
245                  DO 110, I = 1, J - 1
246                     TEMP = TEMP - A( I, J )*X( IX )
247                     IX   = IX   + INCX
248  110             CONTINUE
249                  IF( NOUNIT )
250     $               TEMP = TEMP/A( J, J )
251                  X( JX ) = TEMP
252                  JX      = JX   + INCX
253  120          CONTINUE
254            END IF
255         ELSE
256            IF( INCX.EQ.1 )THEN
257               DO 140, J = N, 1, -1
258                  TEMP = X( J )
259                  DO 130, I = N, J + 1, -1
260                     TEMP = TEMP - A( I, J )*X( I )
261  130             CONTINUE
262                  IF( NOUNIT )
263     $               TEMP = TEMP/A( J, J )
264                  X( J ) = TEMP
265  140          CONTINUE
266            ELSE
267               KX = KX + ( N - 1 )*INCX
268               JX = KX
269               DO 160, J = N, 1, -1
270                  TEMP = X( JX )
271                  IX   = KX
272                  DO 150, I = N, J + 1, -1
273                     TEMP = TEMP - A( I, J )*X( IX )
274                     IX   = IX   - INCX
275  150             CONTINUE
276                  IF( NOUNIT )
277     $               TEMP = TEMP/A( J, J )
278                  X( JX ) = TEMP
279                  JX      = JX   - INCX
280  160          CONTINUE
281            END IF
282         END IF
283      END IF
284*
285      RETURN
286*
287*     End of STRSV .
288*
289      END
290