|
1
2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 |
SUBROUTINE ZPPTRI( UPLO, N, AP, INFO )
* * -- LAPACK routine (version 3.3.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- April 2011 -- * * .. Scalar Arguments .. CHARACTER UPLO INTEGER INFO, N * .. * .. Array Arguments .. COMPLEX*16 AP( * ) * .. * * Purpose * ======= * * ZPPTRI computes the inverse of a complex Hermitian positive definite * matrix A using the Cholesky factorization A = U**H*U or A = L*L**H * computed by ZPPTRF. * * Arguments * ========= * * UPLO (input) CHARACTER*1 * = 'U': Upper triangular factor is stored in AP; * = 'L': Lower triangular factor is stored in AP. * * N (input) INTEGER * The order of the matrix A. N >= 0. * * AP (input/output) COMPLEX*16 array, dimension (N*(N+1)/2) * On entry, the triangular factor U or L from the Cholesky * factorization A = U**H*U or A = L*L**H, packed columnwise as * a linear array. The j-th column of U or L is stored in the * array AP as follows: * if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j; * if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n. * * On exit, the upper or lower triangle of the (Hermitian) * inverse of A, overwriting the input factor U or L. * * INFO (output) INTEGER * = 0: successful exit * < 0: if INFO = -i, the i-th argument had an illegal value * > 0: if INFO = i, the (i,i) element of the factor U or L is * zero, and the inverse could not be computed. * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ONE PARAMETER ( ONE = 1.0D+0 ) * .. * .. Local Scalars .. LOGICAL UPPER INTEGER J, JC, JJ, JJN DOUBLE PRECISION AJJ * .. * .. External Functions .. LOGICAL LSAME COMPLEX*16 ZDOTC EXTERNAL LSAME, ZDOTC * .. * .. External Subroutines .. EXTERNAL XERBLA, ZDSCAL, ZHPR, ZTPMV, ZTPTRI * .. * .. Intrinsic Functions .. INTRINSIC DBLE * .. * .. Executable Statements .. * * Test the input parameters. * INFO = 0 UPPER = LSAME( UPLO, 'U' ) IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZPPTRI', -INFO ) RETURN END IF * * Quick return if possible * IF( N.EQ.0 ) $ RETURN * * Invert the triangular Cholesky factor U or L. * CALL ZTPTRI( UPLO, 'Non-unit', N, AP, INFO ) IF( INFO.GT.0 ) $ RETURN IF( UPPER ) THEN * * Compute the product inv(U) * inv(U)**H. * JJ = 0 DO 10 J = 1, N JC = JJ + 1 JJ = JJ + J IF( J.GT.1 ) $ CALL ZHPR( 'Upper', J-1, ONE, AP( JC ), 1, AP ) AJJ = AP( JJ ) CALL ZDSCAL( J, AJJ, AP( JC ), 1 ) 10 CONTINUE * ELSE * * Compute the product inv(L)**H * inv(L). * JJ = 1 DO 20 J = 1, N JJN = JJ + N - J + 1 AP( JJ ) = DBLE( ZDOTC( N-J+1, AP( JJ ), 1, AP( JJ ), 1 ) ) IF( J.LT.N ) $ CALL ZTPMV( 'Lower', 'Conjugate transpose', 'Non-unit', $ N-J, AP( JJN ), AP( JJ+1 ), 1 ) JJ = JJN 20 CONTINUE END IF * RETURN * * End of ZPPTRI * END |