1: SUBROUTINE ZPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO )
2: *
3: * -- LAPACK routine (version 3.2) --
4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6: * November 2006
7: *
8: * .. Scalar Arguments ..
9: CHARACTER UPLO
10: INTEGER INFO, LDB, N, NRHS
11: * ..
12: * .. Array Arguments ..
13: COMPLEX*16 AP( * ), B( LDB, * )
14: * ..
15: *
16: * Purpose
17: * =======
18: *
19: * ZPPTRS solves a system of linear equations A*X = B with a Hermitian
20: * positive definite matrix A in packed storage using the Cholesky
21: * factorization A = U**H*U or A = L*L**H computed by ZPPTRF.
22: *
23: * Arguments
24: * =========
25: *
26: * UPLO (input) CHARACTER*1
27: * = 'U': Upper triangle of A is stored;
28: * = 'L': Lower triangle of A is stored.
29: *
30: * N (input) INTEGER
31: * The order of the matrix A. N >= 0.
32: *
33: * NRHS (input) INTEGER
34: * The number of right hand sides, i.e., the number of columns
35: * of the matrix B. NRHS >= 0.
36: *
37: * AP (input) COMPLEX*16 array, dimension (N*(N+1)/2)
38: * The triangular factor U or L from the Cholesky factorization
39: * A = U**H*U or A = L*L**H, packed columnwise in a linear
40: * array. The j-th column of U or L is stored in the array AP
41: * as follows:
42: * if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
43: * if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
44: *
45: * B (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
46: * On entry, the right hand side matrix B.
47: * On exit, the solution matrix X.
48: *
49: * LDB (input) INTEGER
50: * The leading dimension of the array B. LDB >= max(1,N).
51: *
52: * INFO (output) INTEGER
53: * = 0: successful exit
54: * < 0: if INFO = -i, the i-th argument had an illegal value
55: *
56: * =====================================================================
57: *
58: * .. Local Scalars ..
59: LOGICAL UPPER
60: INTEGER I
61: * ..
62: * .. External Functions ..
63: LOGICAL LSAME
64: EXTERNAL LSAME
65: * ..
66: * .. External Subroutines ..
67: EXTERNAL XERBLA, ZTPSV
68: * ..
69: * .. Intrinsic Functions ..
70: INTRINSIC MAX
71: * ..
72: * .. Executable Statements ..
73: *
74: * Test the input parameters.
75: *
76: INFO = 0
77: UPPER = LSAME( UPLO, 'U' )
78: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
79: INFO = -1
80: ELSE IF( N.LT.0 ) THEN
81: INFO = -2
82: ELSE IF( NRHS.LT.0 ) THEN
83: INFO = -3
84: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
85: INFO = -6
86: END IF
87: IF( INFO.NE.0 ) THEN
88: CALL XERBLA( 'ZPPTRS', -INFO )
89: RETURN
90: END IF
91: *
92: * Quick return if possible
93: *
94: IF( N.EQ.0 .OR. NRHS.EQ.0 )
95: $ RETURN
96: *
97: IF( UPPER ) THEN
98: *
99: * Solve A*X = B where A = U'*U.
100: *
101: DO 10 I = 1, NRHS
102: *
103: * Solve U'*X = B, overwriting B with X.
104: *
105: CALL ZTPSV( 'Upper', 'Conjugate transpose', 'Non-unit', N,
106: $ AP, B( 1, I ), 1 )
107: *
108: * Solve U*X = B, overwriting B with X.
109: *
110: CALL ZTPSV( 'Upper', 'No transpose', 'Non-unit', N, AP,
111: $ B( 1, I ), 1 )
112: 10 CONTINUE
113: ELSE
114: *
115: * Solve A*X = B where A = L*L'.
116: *
117: DO 20 I = 1, NRHS
118: *
119: * Solve L*Y = B, overwriting B with X.
120: *
121: CALL ZTPSV( 'Lower', 'No transpose', 'Non-unit', N, AP,
122: $ B( 1, I ), 1 )
123: *
124: * Solve L'*X = Y, overwriting B with X.
125: *
126: CALL ZTPSV( 'Lower', 'Conjugate transpose', 'Non-unit', N,
127: $ AP, B( 1, I ), 1 )
128: 20 CONTINUE
129: END IF
130: *
131: RETURN
132: *
133: * End of ZPPTRS
134: *
135: END
CVSweb interface <joel.bertrand@systella.fr>