LAPACK 3.3.0
|
00001 SUBROUTINE CPPTRS( UPLO, N, NRHS, AP, B, LDB, 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, LDB, N, NRHS 00011 * .. 00012 * .. Array Arguments .. 00013 COMPLEX AP( * ), B( LDB, * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * CPPTRS solves a system of linear equations A*X = B with a Hermitian 00020 * positive definite matrix A in packed storage using the Cholesky 00021 * factorization A = U**H*U or A = L*L**H computed by CPPTRF. 00022 * 00023 * Arguments 00024 * ========= 00025 * 00026 * UPLO (input) CHARACTER*1 00027 * = 'U': Upper triangle of A is stored; 00028 * = 'L': Lower triangle of A is stored. 00029 * 00030 * N (input) INTEGER 00031 * The order of the matrix A. N >= 0. 00032 * 00033 * NRHS (input) INTEGER 00034 * The number of right hand sides, i.e., the number of columns 00035 * of the matrix B. NRHS >= 0. 00036 * 00037 * AP (input) COMPLEX array, dimension (N*(N+1)/2) 00038 * The triangular factor U or L from the Cholesky factorization 00039 * A = U**H*U or A = L*L**H, packed columnwise in a linear 00040 * array. The j-th column of U or L is stored in the array AP 00041 * as follows: 00042 * if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j; 00043 * if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n. 00044 * 00045 * B (input/output) COMPLEX array, dimension (LDB,NRHS) 00046 * On entry, the right hand side matrix B. 00047 * On exit, the solution matrix X. 00048 * 00049 * LDB (input) INTEGER 00050 * The leading dimension of the array B. LDB >= max(1,N). 00051 * 00052 * INFO (output) INTEGER 00053 * = 0: successful exit 00054 * < 0: if INFO = -i, the i-th argument had an illegal value 00055 * 00056 * ===================================================================== 00057 * 00058 * .. Local Scalars .. 00059 LOGICAL UPPER 00060 INTEGER I 00061 * .. 00062 * .. External Functions .. 00063 LOGICAL LSAME 00064 EXTERNAL LSAME 00065 * .. 00066 * .. External Subroutines .. 00067 EXTERNAL CTPSV, XERBLA 00068 * .. 00069 * .. Intrinsic Functions .. 00070 INTRINSIC MAX 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 ELSE IF( NRHS.LT.0 ) THEN 00083 INFO = -3 00084 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00085 INFO = -6 00086 END IF 00087 IF( INFO.NE.0 ) THEN 00088 CALL XERBLA( 'CPPTRS', -INFO ) 00089 RETURN 00090 END IF 00091 * 00092 * Quick return if possible 00093 * 00094 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 00095 $ RETURN 00096 * 00097 IF( UPPER ) THEN 00098 * 00099 * Solve A*X = B where A = U'*U. 00100 * 00101 DO 10 I = 1, NRHS 00102 * 00103 * Solve U'*X = B, overwriting B with X. 00104 * 00105 CALL CTPSV( 'Upper', 'Conjugate transpose', 'Non-unit', N, 00106 $ AP, B( 1, I ), 1 ) 00107 * 00108 * Solve U*X = B, overwriting B with X. 00109 * 00110 CALL CTPSV( 'Upper', 'No transpose', 'Non-unit', N, AP, 00111 $ B( 1, I ), 1 ) 00112 10 CONTINUE 00113 ELSE 00114 * 00115 * Solve A*X = B where A = L*L'. 00116 * 00117 DO 20 I = 1, NRHS 00118 * 00119 * Solve L*Y = B, overwriting B with X. 00120 * 00121 CALL CTPSV( 'Lower', 'No transpose', 'Non-unit', N, AP, 00122 $ B( 1, I ), 1 ) 00123 * 00124 * Solve L'*X = Y, overwriting B with X. 00125 * 00126 CALL CTPSV( 'Lower', 'Conjugate transpose', 'Non-unit', N, 00127 $ AP, B( 1, I ), 1 ) 00128 20 CONTINUE 00129 END IF 00130 * 00131 RETURN 00132 * 00133 * End of CPPTRS 00134 * 00135 END