Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
Path: blob/devel/mathlibs/src/lapack/cgetrs.f
5191 views
1
SUBROUTINE CGETRS( 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
* September 30, 1994
7
*
8
* .. Scalar Arguments ..
9
CHARACTER TRANS
10
INTEGER INFO, LDA, LDB, N, NRHS
11
* ..
12
* .. Array Arguments ..
13
INTEGER IPIV( * )
14
COMPLEX A( LDA, * ), B( LDB, * )
15
* ..
16
*
17
* Purpose
18
* =======
19
*
20
* CGETRS solves a system of linear equations
21
* A * X = B, A**T * X = B, or A**H * X = B
22
* with a general N-by-N matrix A using the LU factorization computed
23
* by CGETRF.
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**T * X = B (Transpose)
32
* = 'C': A**H * X = B (Conjugate 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) COMPLEX array, dimension (LDA,N)
42
* The factors L and U from the factorization A = P*L*U
43
* as computed by CGETRF.
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 CGETRF; for 1<=i<=N, row i of the
50
* matrix was interchanged with row IPIV(i).
51
*
52
* B (input/output) COMPLEX 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
COMPLEX ONE
67
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
68
* ..
69
* .. Local Scalars ..
70
LOGICAL NOTRAN
71
* ..
72
* .. External Functions ..
73
LOGICAL LSAME
74
EXTERNAL LSAME
75
* ..
76
* .. External Subroutines ..
77
EXTERNAL CLASWP, CTRSM, 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( 'CGETRS', -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 CLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
117
*
118
* Solve L*X = B, overwriting B with X.
119
*
120
CALL CTRSM( '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 CTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
126
$ NRHS, ONE, A, LDA, B, LDB )
127
ELSE
128
*
129
* Solve A**T * X = B or A**H * X = B.
130
*
131
* Solve U'*X = B, overwriting B with X.
132
*
133
CALL CTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, ONE,
134
$ A, LDA, B, LDB )
135
*
136
* Solve L'*X = B, overwriting B with X.
137
*
138
CALL CTRSM( 'Left', 'Lower', TRANS, 'Unit', N, NRHS, ONE, A,
139
$ LDA, B, LDB )
140
*
141
* Apply row interchanges to the solution vectors.
142
*
143
CALL CLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
144
END IF
145
*
146
RETURN
147
*
148
* End of CGETRS
149
*
150
END
151
152