LAPACK 3.3.0
|
00001 SUBROUTINE SPPTRI( 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 REAL AP( * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * SPPTRI computes the inverse of a real symmetric positive definite 00020 * matrix A using the Cholesky factorization A = U**T*U or A = L*L**T 00021 * computed by SPPTRF. 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) REAL array, dimension (N*(N+1)/2) 00034 * On entry, the triangular factor U or L from the Cholesky 00035 * factorization A = U**T*U or A = L*L**T, 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 (symmetric) 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 REAL SDOT 00064 EXTERNAL LSAME, SDOT 00065 * .. 00066 * .. External Subroutines .. 00067 EXTERNAL SSCAL, SSPR, STPMV, STPTRI, XERBLA 00068 * .. 00069 * .. Executable Statements .. 00070 * 00071 * Test the input parameters. 00072 * 00073 INFO = 0 00074 UPPER = LSAME( UPLO, 'U' ) 00075 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00076 INFO = -1 00077 ELSE IF( N.LT.0 ) THEN 00078 INFO = -2 00079 END IF 00080 IF( INFO.NE.0 ) THEN 00081 CALL XERBLA( 'SPPTRI', -INFO ) 00082 RETURN 00083 END IF 00084 * 00085 * Quick return if possible 00086 * 00087 IF( N.EQ.0 ) 00088 $ RETURN 00089 * 00090 * Invert the triangular Cholesky factor U or L. 00091 * 00092 CALL STPTRI( UPLO, 'Non-unit', N, AP, INFO ) 00093 IF( INFO.GT.0 ) 00094 $ RETURN 00095 * 00096 IF( UPPER ) THEN 00097 * 00098 * Compute the product inv(U) * inv(U)'. 00099 * 00100 JJ = 0 00101 DO 10 J = 1, N 00102 JC = JJ + 1 00103 JJ = JJ + J 00104 IF( J.GT.1 ) 00105 $ CALL SSPR( 'Upper', J-1, ONE, AP( JC ), 1, AP ) 00106 AJJ = AP( JJ ) 00107 CALL SSCAL( J, AJJ, AP( JC ), 1 ) 00108 10 CONTINUE 00109 * 00110 ELSE 00111 * 00112 * Compute the product inv(L)' * inv(L). 00113 * 00114 JJ = 1 00115 DO 20 J = 1, N 00116 JJN = JJ + N - J + 1 00117 AP( JJ ) = SDOT( N-J+1, AP( JJ ), 1, AP( JJ ), 1 ) 00118 IF( J.LT.N ) 00119 $ CALL STPMV( 'Lower', 'Transpose', 'Non-unit', N-J, 00120 $ AP( JJN ), AP( JJ+1 ), 1 ) 00121 JJ = JJN 00122 20 CONTINUE 00123 END IF 00124 * 00125 RETURN 00126 * 00127 * End of SPPTRI 00128 * 00129 END