1 SUBROUTINE ZHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
2 *
3 * -- LAPACK routine (version 3.3.1) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * -- April 2011 --
7 *
8 * -- Written by Julie Langou of the Univ. of TN --
9 *
10 * @precisions normal z -> c
11 *
12 * .. Scalar Arguments ..
13 CHARACTER UPLO
14 INTEGER INFO, LDA, LWORK, N
15 * ..
16 * .. Array Arguments ..
17 INTEGER IPIV( * )
18 COMPLEX*16 A( LDA, * ), WORK( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * ZHETRI2 computes the inverse of a COMPLEX*16 hermitian indefinite matrix
25 * A using the factorization A = U*D*U**T or A = L*D*L**T computed by
26 * ZHETRF. ZHETRI2 set the LEADING DIMENSION of the workspace
27 * before calling ZHETRI2X that actually computes the inverse.
28 *
29 * Arguments
30 * =========
31 *
32 * UPLO (input) CHARACTER*1
33 * Specifies whether the details of the factorization are stored
34 * as an upper or lower triangular matrix.
35 * = 'U': Upper triangular, form is A = U*D*U**T;
36 * = 'L': Lower triangular, form is A = L*D*L**T.
37 *
38 * N (input) INTEGER
39 * The order of the matrix A. N >= 0.
40 *
41 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
42 * On entry, the NB diagonal matrix D and the multipliers
43 * used to obtain the factor U or L as computed by ZHETRF.
44 *
45 * On exit, if INFO = 0, the (symmetric) inverse of the original
46 * matrix. If UPLO = 'U', the upper triangular part of the
47 * inverse is formed and the part of A below the diagonal is not
48 * referenced; if UPLO = 'L' the lower triangular part of the
49 * inverse is formed and the part of A above the diagonal is
50 * not referenced.
51 *
52 * LDA (input) INTEGER
53 * The leading dimension of the array A. LDA >= max(1,N).
54 *
55 * IPIV (input) INTEGER array, dimension (N)
56 * Details of the interchanges and the NB structure of D
57 * as determined by ZHETRF.
58 *
59 * WORK (workspace) COMPLEX*16 array, dimension (N+NB+1)*(NB+3)
60 *
61 * LWORK (input) INTEGER
62 * The dimension of the array WORK.
63 * WORK is size >= (N+NB+1)*(NB+3)
64 * If LDWORK = -1, then a workspace query is assumed; the routine
65 * calculates:
66 * - the optimal size of the WORK array, returns
67 * this value as the first entry of the WORK array,
68 * - and no error message related to LDWORK is issued by XERBLA.
69 *
70 * INFO (output) INTEGER
71 * = 0: successful exit
72 * < 0: if INFO = -i, the i-th argument had an illegal value
73 * > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
74 * inverse could not be computed.
75 *
76 * =====================================================================
77 *
78 * .. Local Scalars ..
79 LOGICAL UPPER, LQUERY
80 INTEGER MINSIZE, NBMAX
81 * ..
82 * .. External Functions ..
83 LOGICAL LSAME
84 INTEGER ILAENV
85 EXTERNAL LSAME, ILAENV
86 * ..
87 * .. External Subroutines ..
88 EXTERNAL ZHETRI2X
89 * ..
90 * .. Executable Statements ..
91 *
92 * Test the input parameters.
93 *
94 INFO = 0
95 UPPER = LSAME( UPLO, 'U' )
96 LQUERY = ( LWORK.EQ.-1 )
97 * Get blocksize
98 NBMAX = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 )
99 IF ( NBMAX .GE. N ) THEN
100 MINSIZE = N
101 ELSE
102 MINSIZE = (N+NBMAX+1)*(NBMAX+3)
103 END IF
104 *
105 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
106 INFO = -1
107 ELSE IF( N.LT.0 ) THEN
108 INFO = -2
109 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
110 INFO = -4
111 ELSE IF (LWORK .LT. MINSIZE .AND. .NOT.LQUERY ) THEN
112 INFO = -7
113 END IF
114 *
115 * Quick return if possible
116 *
117 *
118 IF( INFO.NE.0 ) THEN
119 CALL XERBLA( 'ZHETRI2', -INFO )
120 RETURN
121 ELSE IF( LQUERY ) THEN
122 WORK(1)=MINSIZE
123 RETURN
124 END IF
125 IF( N.EQ.0 )
126 $ RETURN
127
128 IF( NBMAX .GE. N ) THEN
129 CALL ZHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
130 ELSE
131 CALL ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
132 END IF
133 RETURN
134 *
135 * End of ZHETRI2
136 *
137 END
2 *
3 * -- LAPACK routine (version 3.3.1) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * -- April 2011 --
7 *
8 * -- Written by Julie Langou of the Univ. of TN --
9 *
10 * @precisions normal z -> c
11 *
12 * .. Scalar Arguments ..
13 CHARACTER UPLO
14 INTEGER INFO, LDA, LWORK, N
15 * ..
16 * .. Array Arguments ..
17 INTEGER IPIV( * )
18 COMPLEX*16 A( LDA, * ), WORK( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * ZHETRI2 computes the inverse of a COMPLEX*16 hermitian indefinite matrix
25 * A using the factorization A = U*D*U**T or A = L*D*L**T computed by
26 * ZHETRF. ZHETRI2 set the LEADING DIMENSION of the workspace
27 * before calling ZHETRI2X that actually computes the inverse.
28 *
29 * Arguments
30 * =========
31 *
32 * UPLO (input) CHARACTER*1
33 * Specifies whether the details of the factorization are stored
34 * as an upper or lower triangular matrix.
35 * = 'U': Upper triangular, form is A = U*D*U**T;
36 * = 'L': Lower triangular, form is A = L*D*L**T.
37 *
38 * N (input) INTEGER
39 * The order of the matrix A. N >= 0.
40 *
41 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
42 * On entry, the NB diagonal matrix D and the multipliers
43 * used to obtain the factor U or L as computed by ZHETRF.
44 *
45 * On exit, if INFO = 0, the (symmetric) inverse of the original
46 * matrix. If UPLO = 'U', the upper triangular part of the
47 * inverse is formed and the part of A below the diagonal is not
48 * referenced; if UPLO = 'L' the lower triangular part of the
49 * inverse is formed and the part of A above the diagonal is
50 * not referenced.
51 *
52 * LDA (input) INTEGER
53 * The leading dimension of the array A. LDA >= max(1,N).
54 *
55 * IPIV (input) INTEGER array, dimension (N)
56 * Details of the interchanges and the NB structure of D
57 * as determined by ZHETRF.
58 *
59 * WORK (workspace) COMPLEX*16 array, dimension (N+NB+1)*(NB+3)
60 *
61 * LWORK (input) INTEGER
62 * The dimension of the array WORK.
63 * WORK is size >= (N+NB+1)*(NB+3)
64 * If LDWORK = -1, then a workspace query is assumed; the routine
65 * calculates:
66 * - the optimal size of the WORK array, returns
67 * this value as the first entry of the WORK array,
68 * - and no error message related to LDWORK is issued by XERBLA.
69 *
70 * INFO (output) INTEGER
71 * = 0: successful exit
72 * < 0: if INFO = -i, the i-th argument had an illegal value
73 * > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
74 * inverse could not be computed.
75 *
76 * =====================================================================
77 *
78 * .. Local Scalars ..
79 LOGICAL UPPER, LQUERY
80 INTEGER MINSIZE, NBMAX
81 * ..
82 * .. External Functions ..
83 LOGICAL LSAME
84 INTEGER ILAENV
85 EXTERNAL LSAME, ILAENV
86 * ..
87 * .. External Subroutines ..
88 EXTERNAL ZHETRI2X
89 * ..
90 * .. Executable Statements ..
91 *
92 * Test the input parameters.
93 *
94 INFO = 0
95 UPPER = LSAME( UPLO, 'U' )
96 LQUERY = ( LWORK.EQ.-1 )
97 * Get blocksize
98 NBMAX = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 )
99 IF ( NBMAX .GE. N ) THEN
100 MINSIZE = N
101 ELSE
102 MINSIZE = (N+NBMAX+1)*(NBMAX+3)
103 END IF
104 *
105 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
106 INFO = -1
107 ELSE IF( N.LT.0 ) THEN
108 INFO = -2
109 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
110 INFO = -4
111 ELSE IF (LWORK .LT. MINSIZE .AND. .NOT.LQUERY ) THEN
112 INFO = -7
113 END IF
114 *
115 * Quick return if possible
116 *
117 *
118 IF( INFO.NE.0 ) THEN
119 CALL XERBLA( 'ZHETRI2', -INFO )
120 RETURN
121 ELSE IF( LQUERY ) THEN
122 WORK(1)=MINSIZE
123 RETURN
124 END IF
125 IF( N.EQ.0 )
126 $ RETURN
127
128 IF( NBMAX .GE. N ) THEN
129 CALL ZHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
130 ELSE
131 CALL ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
132 END IF
133 RETURN
134 *
135 * End of ZHETRI2
136 *
137 END