1*> \brief \b CTRTRS
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CTRTRS + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctrtrs.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctrtrs.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctrtrs.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
22*                          INFO )
23*
24*       .. Scalar Arguments ..
25*       CHARACTER          DIAG, TRANS, UPLO
26*       INTEGER            INFO, LDA, LDB, N, NRHS
27*       ..
28*       .. Array Arguments ..
29*       COMPLEX            A( LDA, * ), B( LDB, * )
30*       ..
31*
32*
33*> \par Purpose:
34*  =============
35*>
36*> \verbatim
37*>
38*> CTRTRS solves a triangular system of the form
39*>
40*>    A * X = B,  A**T * X = B,  or  A**H * X = B,
41*>
42*> where A is a triangular matrix of order N, and B is an N-by-NRHS
43*> matrix.  A check is made to verify that A is nonsingular.
44*> \endverbatim
45*
46*  Arguments:
47*  ==========
48*
49*> \param[in] UPLO
50*> \verbatim
51*>          UPLO is CHARACTER*1
52*>          = 'U':  A is upper triangular;
53*>          = 'L':  A is lower triangular.
54*> \endverbatim
55*>
56*> \param[in] TRANS
57*> \verbatim
58*>          TRANS is CHARACTER*1
59*>          Specifies the form of the system of equations:
60*>          = 'N':  A * X = B     (No transpose)
61*>          = 'T':  A**T * X = B  (Transpose)
62*>          = 'C':  A**H * X = B  (Conjugate transpose)
63*> \endverbatim
64*>
65*> \param[in] DIAG
66*> \verbatim
67*>          DIAG is CHARACTER*1
68*>          = 'N':  A is non-unit triangular;
69*>          = 'U':  A is unit triangular.
70*> \endverbatim
71*>
72*> \param[in] N
73*> \verbatim
74*>          N is INTEGER
75*>          The order of the matrix A.  N >= 0.
76*> \endverbatim
77*>
78*> \param[in] NRHS
79*> \verbatim
80*>          NRHS is INTEGER
81*>          The number of right hand sides, i.e., the number of columns
82*>          of the matrix B.  NRHS >= 0.
83*> \endverbatim
84*>
85*> \param[in] A
86*> \verbatim
87*>          A is COMPLEX array, dimension (LDA,N)
88*>          The triangular matrix A.  If UPLO = 'U', the leading N-by-N
89*>          upper triangular part of the array A contains the upper
90*>          triangular matrix, and the strictly lower triangular part of
91*>          A is not referenced.  If UPLO = 'L', the leading N-by-N lower
92*>          triangular part of the array A contains the lower triangular
93*>          matrix, and the strictly upper triangular part of A is not
94*>          referenced.  If DIAG = 'U', the diagonal elements of A are
95*>          also not referenced and are assumed to be 1.
96*> \endverbatim
97*>
98*> \param[in] LDA
99*> \verbatim
100*>          LDA is INTEGER
101*>          The leading dimension of the array A.  LDA >= max(1,N).
102*> \endverbatim
103*>
104*> \param[in,out] B
105*> \verbatim
106*>          B is COMPLEX array, dimension (LDB,NRHS)
107*>          On entry, the right hand side matrix B.
108*>          On exit, if INFO = 0, the solution matrix X.
109*> \endverbatim
110*>
111*> \param[in] LDB
112*> \verbatim
113*>          LDB is INTEGER
114*>          The leading dimension of the array B.  LDB >= max(1,N).
115*> \endverbatim
116*>
117*> \param[out] INFO
118*> \verbatim
119*>          INFO is INTEGER
120*>          = 0:  successful exit
121*>          < 0: if INFO = -i, the i-th argument had an illegal value
122*>          > 0: if INFO = i, the i-th diagonal element of A is zero,
123*>               indicating that the matrix is singular and the solutions
124*>               X have not been computed.
125*> \endverbatim
126*
127*  Authors:
128*  ========
129*
130*> \author Univ. of Tennessee
131*> \author Univ. of California Berkeley
132*> \author Univ. of Colorado Denver
133*> \author NAG Ltd.
134*
135*> \date November 2011
136*
137*> \ingroup complexOTHERcomputational
138*
139*  =====================================================================
140      SUBROUTINE CTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
141     $                   INFO )
142*
143*  -- LAPACK computational routine (version 3.4.0) --
144*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
145*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
146*     November 2011
147*
148*     .. Scalar Arguments ..
149      CHARACTER          DIAG, TRANS, UPLO
150      INTEGER            INFO, LDA, LDB, N, NRHS
151*     ..
152*     .. Array Arguments ..
153      COMPLEX            A( LDA, * ), B( LDB, * )
154*     ..
155*
156*  =====================================================================
157*
158*     .. Parameters ..
159      COMPLEX            ZERO, ONE
160      PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ),
161     $                   ONE = ( 1.0E+0, 0.0E+0 ) )
162*     ..
163*     .. Local Scalars ..
164      LOGICAL            NOUNIT
165*     ..
166*     .. External Functions ..
167      LOGICAL            LSAME
168      EXTERNAL           LSAME
169*     ..
170*     .. External Subroutines ..
171      EXTERNAL           CTRSM, XERBLA
172*     ..
173*     .. Intrinsic Functions ..
174      INTRINSIC          MAX
175*     ..
176*     .. Executable Statements ..
177*
178*     Test the input parameters.
179*
180      INFO = 0
181      NOUNIT = LSAME( DIAG, 'N' )
182      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
183         INFO = -1
184      ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
185     $         LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
186         INFO = -2
187      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
188         INFO = -3
189      ELSE IF( N.LT.0 ) THEN
190         INFO = -4
191      ELSE IF( NRHS.LT.0 ) THEN
192         INFO = -5
193      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
194         INFO = -7
195      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
196         INFO = -9
197      END IF
198      IF( INFO.NE.0 ) THEN
199         CALL XERBLA( 'CTRTRS', -INFO )
200         RETURN
201      END IF
202*
203*     Quick return if possible
204*
205      IF( N.EQ.0 )
206     $   RETURN
207*
208*     Check for singularity.
209*
210      IF( NOUNIT ) THEN
211         DO 10 INFO = 1, N
212            IF( A( INFO, INFO ).EQ.ZERO )
213     $         RETURN
214   10    CONTINUE
215      END IF
216      INFO = 0
217*
218*     Solve A * x = b,  A**T * x = b,  or  A**H * x = b.
219*
220      CALL CTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B,
221     $            LDB )
222*
223      RETURN
224*
225*     End of CTRTRS
226*
227      END
228