1*> \brief \b ZTRTI2 computes the inverse of a triangular matrix (unblocked algorithm).
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZTRTI2 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztrti2.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztrti2.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztrti2.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZTRTI2( UPLO, DIAG, N, A, LDA, INFO )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          DIAG, UPLO
25*       INTEGER            INFO, LDA, N
26*       ..
27*       .. Array Arguments ..
28*       COMPLEX*16         A( LDA, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> ZTRTI2 computes the inverse of a complex upper or lower triangular
38*> matrix.
39*>
40*> This is the Level 2 BLAS version of the algorithm.
41*> \endverbatim
42*
43*  Arguments:
44*  ==========
45*
46*> \param[in] UPLO
47*> \verbatim
48*>          UPLO is CHARACTER*1
49*>          Specifies whether the matrix A is upper or lower triangular.
50*>          = 'U':  Upper triangular
51*>          = 'L':  Lower triangular
52*> \endverbatim
53*>
54*> \param[in] DIAG
55*> \verbatim
56*>          DIAG is CHARACTER*1
57*>          Specifies whether or not the matrix A is unit triangular.
58*>          = 'N':  Non-unit triangular
59*>          = 'U':  Unit triangular
60*> \endverbatim
61*>
62*> \param[in] N
63*> \verbatim
64*>          N is INTEGER
65*>          The order of the matrix A.  N >= 0.
66*> \endverbatim
67*>
68*> \param[in,out] A
69*> \verbatim
70*>          A is COMPLEX*16 array, dimension (LDA,N)
71*>          On entry, the triangular matrix A.  If UPLO = 'U', the
72*>          leading n by n upper triangular part of the array A contains
73*>          the upper triangular matrix, and the strictly lower
74*>          triangular part of A is not referenced.  If UPLO = 'L', the
75*>          leading n by n lower triangular part of the array A contains
76*>          the lower triangular matrix, and the strictly upper
77*>          triangular part of A is not referenced.  If DIAG = 'U', the
78*>          diagonal elements of A are also not referenced and are
79*>          assumed to be 1.
80*>
81*>          On exit, the (triangular) inverse of the original matrix, in
82*>          the same storage format.
83*> \endverbatim
84*>
85*> \param[in] LDA
86*> \verbatim
87*>          LDA is INTEGER
88*>          The leading dimension of the array A.  LDA >= max(1,N).
89*> \endverbatim
90*>
91*> \param[out] INFO
92*> \verbatim
93*>          INFO is INTEGER
94*>          = 0: successful exit
95*>          < 0: if INFO = -k, the k-th argument had an illegal value
96*> \endverbatim
97*
98*  Authors:
99*  ========
100*
101*> \author Univ. of Tennessee
102*> \author Univ. of California Berkeley
103*> \author Univ. of Colorado Denver
104*> \author NAG Ltd.
105*
106*> \ingroup complex16OTHERcomputational
107*
108*  =====================================================================
109      SUBROUTINE ZTRTI2( UPLO, DIAG, N, A, LDA, INFO )
110*
111*  -- LAPACK computational routine --
112*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
113*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
114*
115*     .. Scalar Arguments ..
116      CHARACTER          DIAG, UPLO
117      INTEGER            INFO, LDA, N
118*     ..
119*     .. Array Arguments ..
120      COMPLEX*16         A( LDA, * )
121*     ..
122*
123*  =====================================================================
124*
125*     .. Parameters ..
126      COMPLEX*16         ONE
127      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
128*     ..
129*     .. Local Scalars ..
130      LOGICAL            NOUNIT, UPPER
131      INTEGER            J
132      COMPLEX*16         AJJ
133*     ..
134*     .. External Functions ..
135      LOGICAL            LSAME
136      EXTERNAL           LSAME
137*     ..
138*     .. External Subroutines ..
139      EXTERNAL           XERBLA, ZSCAL, ZTRMV
140*     ..
141*     .. Intrinsic Functions ..
142      INTRINSIC          MAX
143*     ..
144*     .. Executable Statements ..
145*
146*     Test the input parameters.
147*
148      INFO = 0
149      UPPER = LSAME( UPLO, 'U' )
150      NOUNIT = LSAME( DIAG, 'N' )
151      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
152         INFO = -1
153      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
154         INFO = -2
155      ELSE IF( N.LT.0 ) THEN
156         INFO = -3
157      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
158         INFO = -5
159      END IF
160      IF( INFO.NE.0 ) THEN
161         CALL XERBLA( 'ZTRTI2', -INFO )
162         RETURN
163      END IF
164*
165      IF( UPPER ) THEN
166*
167*        Compute inverse of upper triangular matrix.
168*
169         DO 10 J = 1, N
170            IF( NOUNIT ) THEN
171               A( J, J ) = ONE / A( J, J )
172               AJJ = -A( J, J )
173            ELSE
174               AJJ = -ONE
175            END IF
176*
177*           Compute elements 1:j-1 of j-th column.
178*
179            CALL ZTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
180     $                  A( 1, J ), 1 )
181            CALL ZSCAL( J-1, AJJ, A( 1, J ), 1 )
182   10    CONTINUE
183      ELSE
184*
185*        Compute inverse of lower triangular matrix.
186*
187         DO 20 J = N, 1, -1
188            IF( NOUNIT ) THEN
189               A( J, J ) = ONE / A( J, J )
190               AJJ = -A( J, J )
191            ELSE
192               AJJ = -ONE
193            END IF
194            IF( J.LT.N ) THEN
195*
196*              Compute elements j+1:n of j-th column.
197*
198               CALL ZTRMV( 'Lower', 'No transpose', DIAG, N-J,
199     $                     A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
200               CALL ZSCAL( N-J, AJJ, A( J+1, J ), 1 )
201            END IF
202   20    CONTINUE
203      END IF
204*
205      RETURN
206*
207*     End of ZTRTI2
208*
209      END
210