1 SUBROUTINE ZTRTRI( UPLO, DIAG, N, A, LDA, INFO )
2 *
3 * -- LAPACK routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 CHARACTER DIAG, UPLO
10 INTEGER INFO, LDA, N
11 * ..
12 * .. Array Arguments ..
13 COMPLEX*16 A( LDA, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * ZTRTRI computes the inverse of a complex upper or lower triangular
20 * matrix A.
21 *
22 * This is the Level 3 BLAS version of the algorithm.
23 *
24 * Arguments
25 * =========
26 *
27 * UPLO (input) CHARACTER*1
28 * = 'U': A is upper triangular;
29 * = 'L': A is lower triangular.
30 *
31 * DIAG (input) CHARACTER*1
32 * = 'N': A is non-unit triangular;
33 * = 'U': A is unit triangular.
34 *
35 * N (input) INTEGER
36 * The order of the matrix A. N >= 0.
37 *
38 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
39 * On entry, the triangular matrix A. If UPLO = 'U', the
40 * leading N-by-N upper triangular part of the array A contains
41 * the upper triangular matrix, and the strictly lower
42 * triangular part of A is not referenced. If UPLO = 'L', the
43 * leading N-by-N lower triangular part of the array A contains
44 * the lower triangular matrix, and the strictly upper
45 * triangular part of A is not referenced. If DIAG = 'U', the
46 * diagonal elements of A are also not referenced and are
47 * assumed to be 1.
48 * On exit, the (triangular) inverse of the original matrix, in
49 * the same storage format.
50 *
51 * LDA (input) INTEGER
52 * The leading dimension of the array A. LDA >= max(1,N).
53 *
54 * INFO (output) INTEGER
55 * = 0: successful exit
56 * < 0: if INFO = -i, the i-th argument had an illegal value
57 * > 0: if INFO = i, A(i,i) is exactly zero. The triangular
58 * matrix is singular and its inverse can not be computed.
59 *
60 * =====================================================================
61 *
62 * .. Parameters ..
63 COMPLEX*16 ONE, ZERO
64 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
65 $ ZERO = ( 0.0D+0, 0.0D+0 ) )
66 * ..
67 * .. Local Scalars ..
68 LOGICAL NOUNIT, UPPER
69 INTEGER J, JB, NB, NN
70 * ..
71 * .. External Functions ..
72 LOGICAL LSAME
73 INTEGER ILAENV
74 EXTERNAL LSAME, ILAENV
75 * ..
76 * .. External Subroutines ..
77 EXTERNAL XERBLA, ZTRMM, ZTRSM, ZTRTI2
78 * ..
79 * .. Intrinsic Functions ..
80 INTRINSIC MAX, MIN
81 * ..
82 * .. Executable Statements ..
83 *
84 * Test the input parameters.
85 *
86 INFO = 0
87 UPPER = LSAME( UPLO, 'U' )
88 NOUNIT = LSAME( DIAG, 'N' )
89 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
90 INFO = -1
91 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
92 INFO = -2
93 ELSE IF( N.LT.0 ) THEN
94 INFO = -3
95 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
96 INFO = -5
97 END IF
98 IF( INFO.NE.0 ) THEN
99 CALL XERBLA( 'ZTRTRI', -INFO )
100 RETURN
101 END IF
102 *
103 * Quick return if possible
104 *
105 IF( N.EQ.0 )
106 $ RETURN
107 *
108 * Check for singularity if non-unit.
109 *
110 IF( NOUNIT ) THEN
111 DO 10 INFO = 1, N
112 IF( A( INFO, INFO ).EQ.ZERO )
113 $ RETURN
114 10 CONTINUE
115 INFO = 0
116 END IF
117 *
118 * Determine the block size for this environment.
119 *
120 NB = ILAENV( 1, 'ZTRTRI', UPLO // DIAG, N, -1, -1, -1 )
121 IF( NB.LE.1 .OR. NB.GE.N ) THEN
122 *
123 * Use unblocked code
124 *
125 CALL ZTRTI2( UPLO, DIAG, N, A, LDA, INFO )
126 ELSE
127 *
128 * Use blocked code
129 *
130 IF( UPPER ) THEN
131 *
132 * Compute inverse of upper triangular matrix
133 *
134 DO 20 J = 1, N, NB
135 JB = MIN( NB, N-J+1 )
136 *
137 * Compute rows 1:j-1 of current block column
138 *
139 CALL ZTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1,
140 $ JB, ONE, A, LDA, A( 1, J ), LDA )
141 CALL ZTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1,
142 $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA )
143 *
144 * Compute inverse of current diagonal block
145 *
146 CALL ZTRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO )
147 20 CONTINUE
148 ELSE
149 *
150 * Compute inverse of lower triangular matrix
151 *
152 NN = ( ( N-1 ) / NB )*NB + 1
153 DO 30 J = NN, 1, -NB
154 JB = MIN( NB, N-J+1 )
155 IF( J+JB.LE.N ) THEN
156 *
157 * Compute rows j+jb:n of current block column
158 *
159 CALL ZTRMM( 'Left', 'Lower', 'No transpose', DIAG,
160 $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA,
161 $ A( J+JB, J ), LDA )
162 CALL ZTRSM( 'Right', 'Lower', 'No transpose', DIAG,
163 $ N-J-JB+1, JB, -ONE, A( J, J ), LDA,
164 $ A( J+JB, J ), LDA )
165 END IF
166 *
167 * Compute inverse of current diagonal block
168 *
169 CALL ZTRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO )
170 30 CONTINUE
171 END IF
172 END IF
173 *
174 RETURN
175 *
176 * End of ZTRTRI
177 *
178 END
2 *
3 * -- LAPACK routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 CHARACTER DIAG, UPLO
10 INTEGER INFO, LDA, N
11 * ..
12 * .. Array Arguments ..
13 COMPLEX*16 A( LDA, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * ZTRTRI computes the inverse of a complex upper or lower triangular
20 * matrix A.
21 *
22 * This is the Level 3 BLAS version of the algorithm.
23 *
24 * Arguments
25 * =========
26 *
27 * UPLO (input) CHARACTER*1
28 * = 'U': A is upper triangular;
29 * = 'L': A is lower triangular.
30 *
31 * DIAG (input) CHARACTER*1
32 * = 'N': A is non-unit triangular;
33 * = 'U': A is unit triangular.
34 *
35 * N (input) INTEGER
36 * The order of the matrix A. N >= 0.
37 *
38 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
39 * On entry, the triangular matrix A. If UPLO = 'U', the
40 * leading N-by-N upper triangular part of the array A contains
41 * the upper triangular matrix, and the strictly lower
42 * triangular part of A is not referenced. If UPLO = 'L', the
43 * leading N-by-N lower triangular part of the array A contains
44 * the lower triangular matrix, and the strictly upper
45 * triangular part of A is not referenced. If DIAG = 'U', the
46 * diagonal elements of A are also not referenced and are
47 * assumed to be 1.
48 * On exit, the (triangular) inverse of the original matrix, in
49 * the same storage format.
50 *
51 * LDA (input) INTEGER
52 * The leading dimension of the array A. LDA >= max(1,N).
53 *
54 * INFO (output) INTEGER
55 * = 0: successful exit
56 * < 0: if INFO = -i, the i-th argument had an illegal value
57 * > 0: if INFO = i, A(i,i) is exactly zero. The triangular
58 * matrix is singular and its inverse can not be computed.
59 *
60 * =====================================================================
61 *
62 * .. Parameters ..
63 COMPLEX*16 ONE, ZERO
64 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
65 $ ZERO = ( 0.0D+0, 0.0D+0 ) )
66 * ..
67 * .. Local Scalars ..
68 LOGICAL NOUNIT, UPPER
69 INTEGER J, JB, NB, NN
70 * ..
71 * .. External Functions ..
72 LOGICAL LSAME
73 INTEGER ILAENV
74 EXTERNAL LSAME, ILAENV
75 * ..
76 * .. External Subroutines ..
77 EXTERNAL XERBLA, ZTRMM, ZTRSM, ZTRTI2
78 * ..
79 * .. Intrinsic Functions ..
80 INTRINSIC MAX, MIN
81 * ..
82 * .. Executable Statements ..
83 *
84 * Test the input parameters.
85 *
86 INFO = 0
87 UPPER = LSAME( UPLO, 'U' )
88 NOUNIT = LSAME( DIAG, 'N' )
89 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
90 INFO = -1
91 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
92 INFO = -2
93 ELSE IF( N.LT.0 ) THEN
94 INFO = -3
95 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
96 INFO = -5
97 END IF
98 IF( INFO.NE.0 ) THEN
99 CALL XERBLA( 'ZTRTRI', -INFO )
100 RETURN
101 END IF
102 *
103 * Quick return if possible
104 *
105 IF( N.EQ.0 )
106 $ RETURN
107 *
108 * Check for singularity if non-unit.
109 *
110 IF( NOUNIT ) THEN
111 DO 10 INFO = 1, N
112 IF( A( INFO, INFO ).EQ.ZERO )
113 $ RETURN
114 10 CONTINUE
115 INFO = 0
116 END IF
117 *
118 * Determine the block size for this environment.
119 *
120 NB = ILAENV( 1, 'ZTRTRI', UPLO // DIAG, N, -1, -1, -1 )
121 IF( NB.LE.1 .OR. NB.GE.N ) THEN
122 *
123 * Use unblocked code
124 *
125 CALL ZTRTI2( UPLO, DIAG, N, A, LDA, INFO )
126 ELSE
127 *
128 * Use blocked code
129 *
130 IF( UPPER ) THEN
131 *
132 * Compute inverse of upper triangular matrix
133 *
134 DO 20 J = 1, N, NB
135 JB = MIN( NB, N-J+1 )
136 *
137 * Compute rows 1:j-1 of current block column
138 *
139 CALL ZTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1,
140 $ JB, ONE, A, LDA, A( 1, J ), LDA )
141 CALL ZTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1,
142 $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA )
143 *
144 * Compute inverse of current diagonal block
145 *
146 CALL ZTRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO )
147 20 CONTINUE
148 ELSE
149 *
150 * Compute inverse of lower triangular matrix
151 *
152 NN = ( ( N-1 ) / NB )*NB + 1
153 DO 30 J = NN, 1, -NB
154 JB = MIN( NB, N-J+1 )
155 IF( J+JB.LE.N ) THEN
156 *
157 * Compute rows j+jb:n of current block column
158 *
159 CALL ZTRMM( 'Left', 'Lower', 'No transpose', DIAG,
160 $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA,
161 $ A( J+JB, J ), LDA )
162 CALL ZTRSM( 'Right', 'Lower', 'No transpose', DIAG,
163 $ N-J-JB+1, JB, -ONE, A( J, J ), LDA,
164 $ A( J+JB, J ), LDA )
165 END IF
166 *
167 * Compute inverse of current diagonal block
168 *
169 CALL ZTRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO )
170 30 CONTINUE
171 END IF
172 END IF
173 *
174 RETURN
175 *
176 * End of ZTRTRI
177 *
178 END