LAPACK 3.3.0

cpptri.f

Go to the documentation of this file.
00001       SUBROUTINE CPPTRI( UPLO, N, AP, INFO )
00002 *
00003 *  -- LAPACK routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       CHARACTER          UPLO
00010       INTEGER            INFO, N
00011 *     ..
00012 *     .. Array Arguments ..
00013       COMPLEX            AP( * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  CPPTRI computes the inverse of a complex Hermitian positive definite
00020 *  matrix A using the Cholesky factorization A = U**H*U or A = L*L**H
00021 *  computed by CPPTRF.
00022 *
00023 *  Arguments
00024 *  =========
00025 *
00026 *  UPLO    (input) CHARACTER*1
00027 *          = 'U':  Upper triangular factor is stored in AP;
00028 *          = 'L':  Lower triangular factor is stored in AP.
00029 *
00030 *  N       (input) INTEGER
00031 *          The order of the matrix A.  N >= 0.
00032 *
00033 *  AP      (input/output) COMPLEX array, dimension (N*(N+1)/2)
00034 *          On entry, the triangular factor U or L from the Cholesky
00035 *          factorization A = U**H*U or A = L*L**H, packed columnwise as
00036 *          a linear array.  The j-th column of U or L is stored in the
00037 *          array AP as follows:
00038 *          if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
00039 *          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
00040 *
00041 *          On exit, the upper or lower triangle of the (Hermitian)
00042 *          inverse of A, overwriting the input factor U or L.
00043 *
00044 *  INFO    (output) INTEGER
00045 *          = 0:  successful exit
00046 *          < 0:  if INFO = -i, the i-th argument had an illegal value
00047 *          > 0:  if INFO = i, the (i,i) element of the factor U or L is
00048 *                zero, and the inverse could not be computed.
00049 *
00050 *  =====================================================================
00051 *
00052 *     .. Parameters ..
00053       REAL               ONE
00054       PARAMETER          ( ONE = 1.0E+0 )
00055 *     ..
00056 *     .. Local Scalars ..
00057       LOGICAL            UPPER
00058       INTEGER            J, JC, JJ, JJN
00059       REAL               AJJ
00060 *     ..
00061 *     .. External Functions ..
00062       LOGICAL            LSAME
00063       COMPLEX            CDOTC
00064       EXTERNAL           LSAME, CDOTC
00065 *     ..
00066 *     .. External Subroutines ..
00067       EXTERNAL           CHPR, CSSCAL, CTPMV, CTPTRI, XERBLA
00068 *     ..
00069 *     .. Intrinsic Functions ..
00070       INTRINSIC          REAL
00071 *     ..
00072 *     .. Executable Statements ..
00073 *
00074 *     Test the input parameters.
00075 *
00076       INFO = 0
00077       UPPER = LSAME( UPLO, 'U' )
00078       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00079          INFO = -1
00080       ELSE IF( N.LT.0 ) THEN
00081          INFO = -2
00082       END IF
00083       IF( INFO.NE.0 ) THEN
00084          CALL XERBLA( 'CPPTRI', -INFO )
00085          RETURN
00086       END IF
00087 *
00088 *     Quick return if possible
00089 *
00090       IF( N.EQ.0 )
00091      $   RETURN
00092 *
00093 *     Invert the triangular Cholesky factor U or L.
00094 *
00095       CALL CTPTRI( UPLO, 'Non-unit', N, AP, INFO )
00096       IF( INFO.GT.0 )
00097      $   RETURN
00098       IF( UPPER ) THEN
00099 *
00100 *        Compute the product inv(U) * inv(U)'.
00101 *
00102          JJ = 0
00103          DO 10 J = 1, N
00104             JC = JJ + 1
00105             JJ = JJ + J
00106             IF( J.GT.1 )
00107      $         CALL CHPR( 'Upper', J-1, ONE, AP( JC ), 1, AP )
00108             AJJ = AP( JJ )
00109             CALL CSSCAL( J, AJJ, AP( JC ), 1 )
00110    10    CONTINUE
00111 *
00112       ELSE
00113 *
00114 *        Compute the product inv(L)' * inv(L).
00115 *
00116          JJ = 1
00117          DO 20 J = 1, N
00118             JJN = JJ + N - J + 1
00119             AP( JJ ) = REAL( CDOTC( N-J+1, AP( JJ ), 1, AP( JJ ), 1 ) )
00120             IF( J.LT.N )
00121      $         CALL CTPMV( 'Lower', 'Conjugate transpose', 'Non-unit',
00122      $                     N-J, AP( JJN ), AP( JJ+1 ), 1 )
00123             JJ = JJN
00124    20    CONTINUE
00125       END IF
00126 *
00127       RETURN
00128 *
00129 *     End of CPPTRI
00130 *
00131       END
 All Files Functions