Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
Path: blob/devel/mathlibs/src/lapack/cgbtf2.f
5213 views
1
SUBROUTINE CGBTF2( M, N, KL, KU, AB, LDAB, IPIV, 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
INTEGER INFO, KL, KU, LDAB, M, N
10
* ..
11
* .. Array Arguments ..
12
INTEGER IPIV( * )
13
COMPLEX AB( LDAB, * )
14
* ..
15
*
16
* Purpose
17
* =======
18
*
19
* CGBTF2 computes an LU factorization of a complex m-by-n band matrix
20
* A using partial pivoting with row interchanges.
21
*
22
* This is the unblocked version of the algorithm, calling Level 2 BLAS.
23
*
24
* Arguments
25
* =========
26
*
27
* M (input) INTEGER
28
* The number of rows of the matrix A. M >= 0.
29
*
30
* N (input) INTEGER
31
* The number of columns of the matrix A. N >= 0.
32
*
33
* KL (input) INTEGER
34
* The number of subdiagonals within the band of A. KL >= 0.
35
*
36
* KU (input) INTEGER
37
* The number of superdiagonals within the band of A. KU >= 0.
38
*
39
* AB (input/output) COMPLEX array, dimension (LDAB,N)
40
* On entry, the matrix A in band storage, in rows KL+1 to
41
* 2*KL+KU+1; rows 1 to KL of the array need not be set.
42
* The j-th column of A is stored in the j-th column of the
43
* array AB as follows:
44
* AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
45
*
46
* On exit, details of the factorization: U is stored as an
47
* upper triangular band matrix with KL+KU superdiagonals in
48
* rows 1 to KL+KU+1, and the multipliers used during the
49
* factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
50
* See below for further details.
51
*
52
* LDAB (input) INTEGER
53
* The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
54
*
55
* IPIV (output) INTEGER array, dimension (min(M,N))
56
* The pivot indices; for 1 <= i <= min(M,N), row i of the
57
* matrix was interchanged with row IPIV(i).
58
*
59
* INFO (output) INTEGER
60
* = 0: successful exit
61
* < 0: if INFO = -i, the i-th argument had an illegal value
62
* > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
63
* has been completed, but the factor U is exactly
64
* singular, and division by zero will occur if it is used
65
* to solve a system of equations.
66
*
67
* Further Details
68
* ===============
69
*
70
* The band storage scheme is illustrated by the following example, when
71
* M = N = 6, KL = 2, KU = 1:
72
*
73
* On entry: On exit:
74
*
75
* * * * + + + * * * u14 u25 u36
76
* * * + + + + * * u13 u24 u35 u46
77
* * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
78
* a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
79
* a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
80
* a31 a42 a53 a64 * * m31 m42 m53 m64 * *
81
*
82
* Array elements marked * are not used by the routine; elements marked
83
* + need not be set on entry, but are required by the routine to store
84
* elements of U, because of fill-in resulting from the row
85
* interchanges.
86
*
87
* =====================================================================
88
*
89
* .. Parameters ..
90
COMPLEX ONE, ZERO
91
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ),
92
$ ZERO = ( 0.0E+0, 0.0E+0 ) )
93
* ..
94
* .. Local Scalars ..
95
INTEGER I, J, JP, JU, KM, KV
96
* ..
97
* .. External Functions ..
98
INTEGER ICAMAX
99
EXTERNAL ICAMAX
100
* ..
101
* .. External Subroutines ..
102
EXTERNAL CGERU, CSCAL, CSWAP, XERBLA
103
* ..
104
* .. Intrinsic Functions ..
105
INTRINSIC MAX, MIN
106
* ..
107
* .. Executable Statements ..
108
*
109
* KV is the number of superdiagonals in the factor U, allowing for
110
* fill-in.
111
*
112
KV = KU + KL
113
*
114
* Test the input parameters.
115
*
116
INFO = 0
117
IF( M.LT.0 ) THEN
118
INFO = -1
119
ELSE IF( N.LT.0 ) THEN
120
INFO = -2
121
ELSE IF( KL.LT.0 ) THEN
122
INFO = -3
123
ELSE IF( KU.LT.0 ) THEN
124
INFO = -4
125
ELSE IF( LDAB.LT.KL+KV+1 ) THEN
126
INFO = -6
127
END IF
128
IF( INFO.NE.0 ) THEN
129
CALL XERBLA( 'CGBTF2', -INFO )
130
RETURN
131
END IF
132
*
133
* Quick return if possible
134
*
135
IF( M.EQ.0 .OR. N.EQ.0 )
136
$ RETURN
137
*
138
* Gaussian elimination with partial pivoting
139
*
140
* Set fill-in elements in columns KU+2 to KV to zero.
141
*
142
DO 20 J = KU + 2, MIN( KV, N )
143
DO 10 I = KV - J + 2, KL
144
AB( I, J ) = ZERO
145
10 CONTINUE
146
20 CONTINUE
147
*
148
* JU is the index of the last column affected by the current stage
149
* of the factorization.
150
*
151
JU = 1
152
*
153
DO 40 J = 1, MIN( M, N )
154
*
155
* Set fill-in elements in column J+KV to zero.
156
*
157
IF( J+KV.LE.N ) THEN
158
DO 30 I = 1, KL
159
AB( I, J+KV ) = ZERO
160
30 CONTINUE
161
END IF
162
*
163
* Find pivot and test for singularity. KM is the number of
164
* subdiagonal elements in the current column.
165
*
166
KM = MIN( KL, M-J )
167
JP = ICAMAX( KM+1, AB( KV+1, J ), 1 )
168
IPIV( J ) = JP + J - 1
169
IF( AB( KV+JP, J ).NE.ZERO ) THEN
170
JU = MAX( JU, MIN( J+KU+JP-1, N ) )
171
*
172
* Apply interchange to columns J to JU.
173
*
174
IF( JP.NE.1 )
175
$ CALL CSWAP( JU-J+1, AB( KV+JP, J ), LDAB-1,
176
$ AB( KV+1, J ), LDAB-1 )
177
IF( KM.GT.0 ) THEN
178
*
179
* Compute multipliers.
180
*
181
CALL CSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), 1 )
182
*
183
* Update trailing submatrix within the band.
184
*
185
IF( JU.GT.J )
186
$ CALL CGERU( KM, JU-J, -ONE, AB( KV+2, J ), 1,
187
$ AB( KV, J+1 ), LDAB-1, AB( KV+1, J+1 ),
188
$ LDAB-1 )
189
END IF
190
ELSE
191
*
192
* If pivot is zero, set INFO to the index of the pivot
193
* unless a zero pivot has already been found.
194
*
195
IF( INFO.EQ.0 )
196
$ INFO = J
197
END IF
198
40 CONTINUE
199
RETURN
200
*
201
* End of CGBTF2
202
*
203
END
204
205