1 SUBROUTINE SPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
2 *
3 * -- LAPACK routine (version 3.3.1) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * -- April 2011 --
7 *
8 * .. Scalar Arguments ..
9 CHARACTER UPLO
10 INTEGER INFO, LDA, LDB, N, NRHS
11 * ..
12 * .. Array Arguments ..
13 REAL A( LDA, * ), B( LDB, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * SPOTRS solves a system of linear equations A*X = B with a symmetric
20 * positive definite matrix A using the Cholesky factorization
21 * A = U**T*U or A = L*L**T computed by SPOTRF.
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 * A (input) REAL array, dimension (LDA,N)
38 * The triangular factor U or L from the Cholesky factorization
39 * A = U**T*U or A = L*L**T, as computed by SPOTRF.
40 *
41 * LDA (input) INTEGER
42 * The leading dimension of the array A. LDA >= max(1,N).
43 *
44 * B (input/output) REAL array, dimension (LDB,NRHS)
45 * On entry, the right hand side matrix B.
46 * On exit, the solution matrix X.
47 *
48 * LDB (input) INTEGER
49 * The leading dimension of the array B. LDB >= max(1,N).
50 *
51 * INFO (output) INTEGER
52 * = 0: successful exit
53 * < 0: if INFO = -i, the i-th argument had an illegal value
54 *
55 * =====================================================================
56 *
57 * .. Parameters ..
58 REAL ONE
59 PARAMETER ( ONE = 1.0E+0 )
60 * ..
61 * .. Local Scalars ..
62 LOGICAL UPPER
63 * ..
64 * .. External Functions ..
65 LOGICAL LSAME
66 EXTERNAL LSAME
67 * ..
68 * .. External Subroutines ..
69 EXTERNAL STRSM, XERBLA
70 * ..
71 * .. Intrinsic Functions ..
72 INTRINSIC MAX
73 * ..
74 * .. Executable Statements ..
75 *
76 * Test the input parameters.
77 *
78 INFO = 0
79 UPPER = LSAME( UPLO, 'U' )
80 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
81 INFO = -1
82 ELSE IF( N.LT.0 ) THEN
83 INFO = -2
84 ELSE IF( NRHS.LT.0 ) THEN
85 INFO = -3
86 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
87 INFO = -5
88 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
89 INFO = -7
90 END IF
91 IF( INFO.NE.0 ) THEN
92 CALL XERBLA( 'SPOTRS', -INFO )
93 RETURN
94 END IF
95 *
96 * Quick return if possible
97 *
98 IF( N.EQ.0 .OR. NRHS.EQ.0 )
99 $ RETURN
100 *
101 IF( UPPER ) THEN
102 *
103 * Solve A*X = B where A = U**T *U.
104 *
105 * Solve U**T *X = B, overwriting B with X.
106 *
107 CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
108 $ ONE, A, LDA, B, LDB )
109 *
110 * Solve U*X = B, overwriting B with X.
111 *
112 CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
113 $ NRHS, ONE, A, LDA, B, LDB )
114 ELSE
115 *
116 * Solve A*X = B where A = L*L**T.
117 *
118 * Solve L*X = B, overwriting B with X.
119 *
120 CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', N,
121 $ NRHS, ONE, A, LDA, B, LDB )
122 *
123 * Solve L**T *X = B, overwriting B with X.
124 *
125 CALL STRSM( 'Left', 'Lower', 'Transpose', 'Non-unit', N, NRHS,
126 $ ONE, A, LDA, B, LDB )
127 END IF
128 *
129 RETURN
130 *
131 * End of SPOTRS
132 *
133 END
2 *
3 * -- LAPACK routine (version 3.3.1) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * -- April 2011 --
7 *
8 * .. Scalar Arguments ..
9 CHARACTER UPLO
10 INTEGER INFO, LDA, LDB, N, NRHS
11 * ..
12 * .. Array Arguments ..
13 REAL A( LDA, * ), B( LDB, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * SPOTRS solves a system of linear equations A*X = B with a symmetric
20 * positive definite matrix A using the Cholesky factorization
21 * A = U**T*U or A = L*L**T computed by SPOTRF.
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 * A (input) REAL array, dimension (LDA,N)
38 * The triangular factor U or L from the Cholesky factorization
39 * A = U**T*U or A = L*L**T, as computed by SPOTRF.
40 *
41 * LDA (input) INTEGER
42 * The leading dimension of the array A. LDA >= max(1,N).
43 *
44 * B (input/output) REAL array, dimension (LDB,NRHS)
45 * On entry, the right hand side matrix B.
46 * On exit, the solution matrix X.
47 *
48 * LDB (input) INTEGER
49 * The leading dimension of the array B. LDB >= max(1,N).
50 *
51 * INFO (output) INTEGER
52 * = 0: successful exit
53 * < 0: if INFO = -i, the i-th argument had an illegal value
54 *
55 * =====================================================================
56 *
57 * .. Parameters ..
58 REAL ONE
59 PARAMETER ( ONE = 1.0E+0 )
60 * ..
61 * .. Local Scalars ..
62 LOGICAL UPPER
63 * ..
64 * .. External Functions ..
65 LOGICAL LSAME
66 EXTERNAL LSAME
67 * ..
68 * .. External Subroutines ..
69 EXTERNAL STRSM, XERBLA
70 * ..
71 * .. Intrinsic Functions ..
72 INTRINSIC MAX
73 * ..
74 * .. Executable Statements ..
75 *
76 * Test the input parameters.
77 *
78 INFO = 0
79 UPPER = LSAME( UPLO, 'U' )
80 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
81 INFO = -1
82 ELSE IF( N.LT.0 ) THEN
83 INFO = -2
84 ELSE IF( NRHS.LT.0 ) THEN
85 INFO = -3
86 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
87 INFO = -5
88 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
89 INFO = -7
90 END IF
91 IF( INFO.NE.0 ) THEN
92 CALL XERBLA( 'SPOTRS', -INFO )
93 RETURN
94 END IF
95 *
96 * Quick return if possible
97 *
98 IF( N.EQ.0 .OR. NRHS.EQ.0 )
99 $ RETURN
100 *
101 IF( UPPER ) THEN
102 *
103 * Solve A*X = B where A = U**T *U.
104 *
105 * Solve U**T *X = B, overwriting B with X.
106 *
107 CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
108 $ ONE, A, LDA, B, LDB )
109 *
110 * Solve U*X = B, overwriting B with X.
111 *
112 CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
113 $ NRHS, ONE, A, LDA, B, LDB )
114 ELSE
115 *
116 * Solve A*X = B where A = L*L**T.
117 *
118 * Solve L*X = B, overwriting B with X.
119 *
120 CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', N,
121 $ NRHS, ONE, A, LDA, B, LDB )
122 *
123 * Solve L**T *X = B, overwriting B with X.
124 *
125 CALL STRSM( 'Left', 'Lower', 'Transpose', 'Non-unit', N, NRHS,
126 $ ONE, A, LDA, B, LDB )
127 END IF
128 *
129 RETURN
130 *
131 * End of SPOTRS
132 *
133 END