1      SUBROUTINE STRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
2     $                   INFO )
3*
4*  -- LAPACK routine (version 3.0) --
5*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
6*     Courant Institute, Argonne National Lab, and Rice University
7*     March 31, 1993
8*
9*     .. Scalar Arguments ..
10      CHARACTER          DIAG, TRANS, UPLO
11      INTEGER            INFO, LDA, LDB, N, NRHS
12*     ..
13*     .. Array Arguments ..
14      REAL               A( LDA, * ), B( LDB, * )
15*     ..
16*
17*  Purpose
18*  =======
19*
20*  STRTRS solves a triangular system of the form
21*
22*     A * X = B  or  A**T * X = B,
23*
24*  where A is a triangular matrix of order N, and B is an N-by-NRHS
25*  matrix.  A check is made to verify that A is nonsingular.
26*
27*  Arguments
28*  =========
29*
30*  UPLO    (input) CHARACTER*1
31*          = 'U':  A is upper triangular;
32*          = 'L':  A is lower triangular.
33*
34*  TRANS   (input) CHARACTER*1
35*          Specifies the form of the system of equations:
36*          = 'N':  A * X = B  (No transpose)
37*          = 'T':  A**T * X = B  (Transpose)
38*          = 'C':  A**H * X = B  (Conjugate transpose = Transpose)
39*
40*  DIAG    (input) CHARACTER*1
41*          = 'N':  A is non-unit triangular;
42*          = 'U':  A is unit triangular.
43*
44*  N       (input) INTEGER
45*          The order of the matrix A.  N >= 0.
46*
47*  NRHS    (input) INTEGER
48*          The number of right hand sides, i.e., the number of columns
49*          of the matrix B.  NRHS >= 0.
50*
51*  A       (input) REAL array, dimension (LDA,N)
52*          The triangular matrix A.  If UPLO = 'U', the leading N-by-N
53*          upper triangular part of the array A contains the upper
54*          triangular matrix, and the strictly lower triangular part of
55*          A is not referenced.  If UPLO = 'L', the leading N-by-N lower
56*          triangular part of the array A contains the lower triangular
57*          matrix, and the strictly upper triangular part of A is not
58*          referenced.  If DIAG = 'U', the diagonal elements of A are
59*          also not referenced and are assumed to be 1.
60*
61*  LDA     (input) INTEGER
62*          The leading dimension of the array A.  LDA >= max(1,N).
63*
64*  B       (input/output) REAL array, dimension (LDB,NRHS)
65*          On entry, the right hand side matrix B.
66*          On exit, if INFO = 0, the solution matrix X.
67*
68*  LDB     (input) INTEGER
69*          The leading dimension of the array B.  LDB >= max(1,N).
70*
71*  INFO    (output) INTEGER
72*          = 0:  successful exit
73*          < 0: if INFO = -i, the i-th argument had an illegal value
74*          > 0: if INFO = i, the i-th diagonal element of A is zero,
75*               indicating that the matrix is singular and the solutions
76*               X have not been computed.
77*
78*  =====================================================================
79*
80*     .. Parameters ..
81      REAL               ZERO, ONE
82      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
83*     ..
84*     .. Local Scalars ..
85      LOGICAL            NOUNIT
86*     ..
87*     .. External Functions ..
88      LOGICAL            LSAME
89      EXTERNAL           LSAME
90*     ..
91*     .. External Subroutines ..
92      EXTERNAL           STRSM, XERBLA
93*     ..
94*     .. Intrinsic Functions ..
95      INTRINSIC          MAX
96*     ..
97*     .. Executable Statements ..
98*
99*     Test the input parameters.
100*
101      INFO = 0
102      NOUNIT = LSAME( DIAG, 'N' )
103      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
104         INFO = -1
105      ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
106     $         LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
107         INFO = -2
108      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
109         INFO = -3
110      ELSE IF( N.LT.0 ) THEN
111         INFO = -4
112      ELSE IF( NRHS.LT.0 ) THEN
113         INFO = -5
114      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
115         INFO = -7
116      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
117         INFO = -9
118      END IF
119      IF( INFO.NE.0 ) THEN
120         CALL XERBLA( 'STRTRS', -INFO )
121         RETURN
122      END IF
123*
124*     Quick return if possible
125*
126      IF( N.EQ.0 )
127     $   RETURN
128*
129*     Check for singularity.
130*
131      IF( NOUNIT ) THEN
132         DO 10 INFO = 1, N
133            IF( A( INFO, INFO ).EQ.ZERO )
134     $         RETURN
135   10    CONTINUE
136      END IF
137      INFO = 0
138*
139*     Solve A * x = b  or  A' * x = b.
140*
141      CALL STRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B,
142     $            LDB )
143*
144      RETURN
145*
146*     End of STRTRS
147*
148      END
149