3 /* Table of constant values */
5 static real c_b9 = 1.f;
7 /* Subroutine */ int spotrs_(char *uplo, integer *n, integer *nrhs, real *a,
8 integer *lda, real *b, integer *ldb, integer *info)
10 /* System generated locals */
11 integer a_dim1, a_offset, b_dim1, b_offset, i__1;
14 extern logical lsame_(char *, char *);
16 extern /* Subroutine */ int strsm_(char *, char *, char *, char *,
17 integer *, integer *, real *, real *, integer *, real *, integer *
18 ), xerbla_(char *, integer *);
21 /* -- LAPACK routine (version 3.1) -- */
22 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
25 /* .. Scalar Arguments .. */
27 /* .. Array Arguments .. */
33 /* SPOTRS solves a system of linear equations A*X = B with a symmetric */
34 /* positive definite matrix A using the Cholesky factorization */
35 /* A = U**T*U or A = L*L**T computed by SPOTRF. */
40 /* UPLO (input) CHARACTER*1 */
41 /* = 'U': Upper triangle of A is stored; */
42 /* = 'L': Lower triangle of A is stored. */
44 /* N (input) INTEGER */
45 /* The order of the matrix A. N >= 0. */
47 /* NRHS (input) INTEGER */
48 /* The number of right hand sides, i.e., the number of columns */
49 /* of the matrix B. NRHS >= 0. */
51 /* A (input) REAL array, dimension (LDA,N) */
52 /* The triangular factor U or L from the Cholesky factorization */
53 /* A = U**T*U or A = L*L**T, as computed by SPOTRF. */
55 /* LDA (input) INTEGER */
56 /* The leading dimension of the array A. LDA >= max(1,N). */
58 /* B (input/output) REAL array, dimension (LDB,NRHS) */
59 /* On entry, the right hand side matrix B. */
60 /* On exit, the solution matrix X. */
62 /* LDB (input) INTEGER */
63 /* The leading dimension of the array B. LDB >= max(1,N). */
65 /* INFO (output) INTEGER */
66 /* = 0: successful exit */
67 /* < 0: if INFO = -i, the i-th argument had an illegal value */
69 /* ===================================================================== */
71 /* .. Parameters .. */
73 /* .. Local Scalars .. */
75 /* .. External Functions .. */
77 /* .. External Subroutines .. */
79 /* .. Intrinsic Functions .. */
81 /* .. Executable Statements .. */
83 /* Test the input parameters. */
85 /* Parameter adjustments */
87 a_offset = 1 + a_dim1;
90 b_offset = 1 + b_dim1;
95 upper = lsame_(uplo, "U");
96 if (! upper && ! lsame_(uplo, "L")) {
100 } else if (*nrhs < 0) {
102 } else if (*lda < max(1,*n)) {
104 } else if (*ldb < max(1,*n)) {
109 xerbla_("SPOTRS", &i__1);
113 /* Quick return if possible */
115 if (*n == 0 || *nrhs == 0) {
121 /* Solve A*X = B where A = U'*U. */
123 /* Solve U'*X = B, overwriting B with X. */
125 strsm_("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &c_b9, &a[
126 a_offset], lda, &b[b_offset], ldb);
128 /* Solve U*X = B, overwriting B with X. */
130 strsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b9, &
131 a[a_offset], lda, &b[b_offset], ldb);
134 /* Solve A*X = B where A = L*L'. */
136 /* Solve L*X = B, overwriting B with X. */
138 strsm_("Left", "Lower", "No transpose", "Non-unit", n, nrhs, &c_b9, &
139 a[a_offset], lda, &b[b_offset], ldb);
141 /* Solve L'*X = B, overwriting B with X. */
143 strsm_("Left", "Lower", "Transpose", "Non-unit", n, nrhs, &c_b9, &a[
144 a_offset], lda, &b[b_offset], ldb);