KTH framework for Nek5000 toolboxes; testing version  0.0.1
dpotrs.f
Go to the documentation of this file.
1  SUBROUTINE dpotrs( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
2 *
3 * -- LAPACK routine (version 3.0) --
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5 * Courant Institute, Argonne National Lab, and Rice University
6 * March 31, 1993
7 *
8 * .. Scalar Arguments ..
9  CHARACTER UPLO
10  INTEGER INFO, LDA, LDB, N, NRHS
11 * ..
12 * .. Array Arguments ..
13  DOUBLE PRECISION A( LDA, * ), B( LDB, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DPOTRS 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 DPOTRF.
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) DOUBLE PRECISION 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 DPOTRF.
40 *
41 * LDA (input) INTEGER
42 * The leading dimension of the array A. LDA >= max(1,N).
43 *
44 * B (input/output) DOUBLE PRECISION 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  DOUBLE PRECISION ONE
59  parameter( one = 1.0d+0 )
60 * ..
61 * .. Local Scalars ..
62  LOGICAL UPPER
63 * ..
64 * .. External Functions ..
65  LOGICAL LSAME
66  EXTERNAL lsame
67 * ..
68 * .. External Subroutines ..
69  EXTERNAL dtrsm, 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( 'DPOTRS', -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'*U.
104 *
105 * Solve U'*X = B, overwriting B with X.
106 *
107  CALL dtrsm( '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 dtrsm( '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'.
117 *
118 * Solve L*X = B, overwriting B with X.
119 *
120  CALL dtrsm( 'Left', 'Lower', 'No transpose', 'Non-unit', n,
121  $ nrhs, one, a, lda, b, ldb )
122 *
123 * Solve L'*X = B, overwriting B with X.
124 *
125  CALL dtrsm( 'Left', 'Lower', 'Transpose', 'Non-unit', n, nrhs,
126  $ one, a, lda, b, ldb )
127  END IF
128 *
129  RETURN
130 *
131 * End of DPOTRS
132 *
133  END
subroutine dpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
Definition: dpotrs.f:2
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
Definition: dtrsm.f:3
subroutine xerbla(SRNAME, INFO)
Definition: xerbla.f:2