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