KTH framework for Nek5000 toolboxes; testing version  0.0.1
dgetrs.f
Go to the documentation of this file.
1  SUBROUTINE dgetrs( TRANS, N, NRHS, A, LDA, IPIV, 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 TRANS
10  INTEGER INFO, LDA, LDB, N, NRHS
11 * ..
12 * .. Array Arguments ..
13  INTEGER IPIV( * )
14  DOUBLE PRECISION A( LDA, * ), B( LDB, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * DGETRS solves a system of linear equations
21 * A * X = B or A' * X = B
22 * with a general N-by-N matrix A using the LU factorization computed
23 * by DGETRF.
24 *
25 * Arguments
26 * =========
27 *
28 * TRANS (input) CHARACTER*1
29 * Specifies the form of the system of equations:
30 * = 'N': A * X = B (No transpose)
31 * = 'T': A'* X = B (Transpose)
32 * = 'C': A'* X = B (Conjugate transpose = Transpose)
33 *
34 * N (input) INTEGER
35 * The order of the matrix A. N >= 0.
36 *
37 * NRHS (input) INTEGER
38 * The number of right hand sides, i.e., the number of columns
39 * of the matrix B. NRHS >= 0.
40 *
41 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
42 * The factors L and U from the factorization A = P*L*U
43 * as computed by DGETRF.
44 *
45 * LDA (input) INTEGER
46 * The leading dimension of the array A. LDA >= max(1,N).
47 *
48 * IPIV (input) INTEGER array, dimension (N)
49 * The pivot indices from DGETRF; for 1<=i<=N, row i of the
50 * matrix was interchanged with row IPIV(i).
51 *
52 * B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
53 * On entry, the right hand side matrix B.
54 * On exit, the solution matrix X.
55 *
56 * LDB (input) INTEGER
57 * The leading dimension of the array B. LDB >= max(1,N).
58 *
59 * INFO (output) INTEGER
60 * = 0: successful exit
61 * < 0: if INFO = -i, the i-th argument had an illegal value
62 *
63 * =====================================================================
64 *
65 * .. Parameters ..
66  DOUBLE PRECISION ONE
67  parameter( one = 1.0d+0 )
68 * ..
69 * .. Local Scalars ..
70  LOGICAL NOTRAN
71 * ..
72 * .. External Functions ..
73  LOGICAL LSAME
74  EXTERNAL lsame
75 * ..
76 * .. External Subroutines ..
77  EXTERNAL dlaswp, dtrsm, xerbla
78 * ..
79 * .. Intrinsic Functions ..
80  INTRINSIC max
81 * ..
82 * .. Executable Statements ..
83 *
84 * Test the input parameters.
85 *
86  info = 0
87  notran = lsame( trans, 'N' )
88  IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) .AND. .NOT.
89  $ lsame( trans, 'C' ) ) THEN
90  info = -1
91  ELSE IF( n.LT.0 ) THEN
92  info = -2
93  ELSE IF( nrhs.LT.0 ) THEN
94  info = -3
95  ELSE IF( lda.LT.max( 1, n ) ) THEN
96  info = -5
97  ELSE IF( ldb.LT.max( 1, n ) ) THEN
98  info = -8
99  END IF
100  IF( info.NE.0 ) THEN
101  CALL xerbla( 'DGETRS', -info )
102  RETURN
103  END IF
104 *
105 * Quick return if possible
106 *
107  IF( n.EQ.0 .OR. nrhs.EQ.0 )
108  $ RETURN
109 *
110  IF( notran ) THEN
111 *
112 * Solve A * X = B.
113 *
114 * Apply row interchanges to the right hand sides.
115 *
116  CALL dlaswp( nrhs, b, ldb, 1, n, ipiv, 1 )
117 *
118 * Solve L*X = B, overwriting B with X.
119 *
120  CALL dtrsm( 'Left', 'Lower', 'No transpose', 'Unit', n, nrhs,
121  $ one, a, lda, b, ldb )
122 *
123 * Solve U*X = B, overwriting B with X.
124 *
125  CALL dtrsm( 'Left', 'Upper', 'No transpose', 'Non-unit', n,
126  $ nrhs, one, a, lda, b, ldb )
127  ELSE
128 *
129 * Solve A' * X = B.
130 *
131 * Solve U'*X = B, overwriting B with X.
132 *
133  CALL dtrsm( 'Left', 'Upper', 'Transpose', 'Non-unit', n, nrhs,
134  $ one, a, lda, b, ldb )
135 *
136 * Solve L'*X = B, overwriting B with X.
137 *
138  CALL dtrsm( 'Left', 'Lower', 'Transpose', 'Unit', n, nrhs, one,
139  $ a, lda, b, ldb )
140 *
141 * Apply row interchanges to the solution vectors.
142 *
143  CALL dlaswp( nrhs, b, ldb, 1, n, ipiv, -1 )
144  END IF
145 *
146  RETURN
147 *
148 * End of DGETRS
149 *
150  END
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
Definition: dgetrs.f:2
subroutine dlaswp(N, A, LDA, K1, K2, IPIV, INCX)
Definition: dlaswp.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