1*> \brief \b CPOTRI
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CPOTRI + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cpotri.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cpotri.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cpotri.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CPOTRI( UPLO, N, A, LDA, INFO )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          UPLO
25*       INTEGER            INFO, LDA, N
26*       ..
27*       .. Array Arguments ..
28*       COMPLEX            A( LDA, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> CPOTRI computes the inverse of a complex Hermitian positive definite
38*> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H
39*> computed by CPOTRF.
40*> \endverbatim
41*
42*  Arguments:
43*  ==========
44*
45*> \param[in] UPLO
46*> \verbatim
47*>          UPLO is CHARACTER*1
48*>          = 'U':  Upper triangle of A is stored;
49*>          = 'L':  Lower triangle of A is stored.
50*> \endverbatim
51*>
52*> \param[in] N
53*> \verbatim
54*>          N is INTEGER
55*>          The order of the matrix A.  N >= 0.
56*> \endverbatim
57*>
58*> \param[in,out] A
59*> \verbatim
60*>          A is COMPLEX array, dimension (LDA,N)
61*>          On entry, the triangular factor U or L from the Cholesky
62*>          factorization A = U**H*U or A = L*L**H, as computed by
63*>          CPOTRF.
64*>          On exit, the upper or lower triangle of the (Hermitian)
65*>          inverse of A, overwriting the input factor U or L.
66*> \endverbatim
67*>
68*> \param[in] LDA
69*> \verbatim
70*>          LDA is INTEGER
71*>          The leading dimension of the array A.  LDA >= max(1,N).
72*> \endverbatim
73*>
74*> \param[out] INFO
75*> \verbatim
76*>          INFO is INTEGER
77*>          = 0:  successful exit
78*>          < 0:  if INFO = -i, the i-th argument had an illegal value
79*>          > 0:  if INFO = i, the (i,i) element of the factor U or L is
80*>                zero, and the inverse could not be computed.
81*> \endverbatim
82*
83*  Authors:
84*  ========
85*
86*> \author Univ. of Tennessee
87*> \author Univ. of California Berkeley
88*> \author Univ. of Colorado Denver
89*> \author NAG Ltd.
90*
91*> \ingroup complexPOcomputational
92*
93*  =====================================================================
94      SUBROUTINE CPOTRI( UPLO, N, A, LDA, INFO )
95*
96*  -- LAPACK computational routine --
97*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
98*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
99*
100*     .. Scalar Arguments ..
101      CHARACTER          UPLO
102      INTEGER            INFO, LDA, N
103*     ..
104*     .. Array Arguments ..
105      COMPLEX            A( LDA, * )
106*     ..
107*
108*  =====================================================================
109*
110*     .. External Functions ..
111      LOGICAL            LSAME
112      EXTERNAL           LSAME
113*     ..
114*     .. External Subroutines ..
115      EXTERNAL           CLAUUM, CTRTRI, XERBLA
116*     ..
117*     .. Intrinsic Functions ..
118      INTRINSIC          MAX
119*     ..
120*     .. Executable Statements ..
121*
122*     Test the input parameters.
123*
124      INFO = 0
125      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
126         INFO = -1
127      ELSE IF( N.LT.0 ) THEN
128         INFO = -2
129      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
130         INFO = -4
131      END IF
132      IF( INFO.NE.0 ) THEN
133         CALL XERBLA( 'CPOTRI', -INFO )
134         RETURN
135      END IF
136*
137*     Quick return if possible
138*
139      IF( N.EQ.0 )
140     $   RETURN
141*
142*     Invert the triangular Cholesky factor U or L.
143*
144      CALL CTRTRI( UPLO, 'Non-unit', N, A, LDA, INFO )
145      IF( INFO.GT.0 )
146     $   RETURN
147*
148*     Form inv(U) * inv(U)**H or inv(L)**H * inv(L).
149*
150      CALL CLAUUM( UPLO, N, A, LDA, INFO )
151*
152      RETURN
153*
154*     End of CPOTRI
155*
156      END
157