Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
Path: blob/devel/mathlibs/src/lapack/cgelqf.f
5213 views
1
SUBROUTINE CGELQF( M, N, A, LDA, TAU, WORK, LWORK, 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
* June 30, 1999
7
*
8
* .. Scalar Arguments ..
9
INTEGER INFO, LDA, LWORK, M, N
10
* ..
11
* .. Array Arguments ..
12
COMPLEX A( LDA, * ), TAU( * ), WORK( * )
13
* ..
14
*
15
* Purpose
16
* =======
17
*
18
* CGELQF computes an LQ factorization of a complex M-by-N matrix A:
19
* A = L * Q.
20
*
21
* Arguments
22
* =========
23
*
24
* M (input) INTEGER
25
* The number of rows of the matrix A. M >= 0.
26
*
27
* N (input) INTEGER
28
* The number of columns of the matrix A. N >= 0.
29
*
30
* A (input/output) COMPLEX array, dimension (LDA,N)
31
* On entry, the M-by-N matrix A.
32
* On exit, the elements on and below the diagonal of the array
33
* contain the m-by-min(m,n) lower trapezoidal matrix L (L is
34
* lower triangular if m <= n); the elements above the diagonal,
35
* with the array TAU, represent the unitary matrix Q as a
36
* product of elementary reflectors (see Further Details).
37
*
38
* LDA (input) INTEGER
39
* The leading dimension of the array A. LDA >= max(1,M).
40
*
41
* TAU (output) COMPLEX array, dimension (min(M,N))
42
* The scalar factors of the elementary reflectors (see Further
43
* Details).
44
*
45
* WORK (workspace/output) COMPLEX array, dimension (LWORK)
46
* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
47
*
48
* LWORK (input) INTEGER
49
* The dimension of the array WORK. LWORK >= max(1,M).
50
* For optimum performance LWORK >= M*NB, where NB is the
51
* optimal blocksize.
52
*
53
* If LWORK = -1, then a workspace query is assumed; the routine
54
* only calculates the optimal size of the WORK array, returns
55
* this value as the first entry of the WORK array, and no error
56
* message related to LWORK is issued by XERBLA.
57
*
58
* INFO (output) INTEGER
59
* = 0: successful exit
60
* < 0: if INFO = -i, the i-th argument had an illegal value
61
*
62
* Further Details
63
* ===============
64
*
65
* The matrix Q is represented as a product of elementary reflectors
66
*
67
* Q = H(k)' . . . H(2)' H(1)', where k = min(m,n).
68
*
69
* Each H(i) has the form
70
*
71
* H(i) = I - tau * v * v'
72
*
73
* where tau is a complex scalar, and v is a complex vector with
74
* v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in
75
* A(i,i+1:n), and tau in TAU(i).
76
*
77
* =====================================================================
78
*
79
* .. Local Scalars ..
80
LOGICAL LQUERY
81
INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
82
$ NBMIN, NX
83
* ..
84
* .. External Subroutines ..
85
EXTERNAL CGELQ2, CLARFB, CLARFT, XERBLA
86
* ..
87
* .. Intrinsic Functions ..
88
INTRINSIC MAX, MIN
89
* ..
90
* .. External Functions ..
91
INTEGER ILAENV
92
EXTERNAL ILAENV
93
* ..
94
* .. Executable Statements ..
95
*
96
* Test the input arguments
97
*
98
INFO = 0
99
NB = ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 )
100
LWKOPT = M*NB
101
WORK( 1 ) = LWKOPT
102
LQUERY = ( LWORK.EQ.-1 )
103
IF( M.LT.0 ) THEN
104
INFO = -1
105
ELSE IF( N.LT.0 ) THEN
106
INFO = -2
107
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
108
INFO = -4
109
ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
110
INFO = -7
111
END IF
112
IF( INFO.NE.0 ) THEN
113
CALL XERBLA( 'CGELQF', -INFO )
114
RETURN
115
ELSE IF( LQUERY ) THEN
116
RETURN
117
END IF
118
*
119
* Quick return if possible
120
*
121
K = MIN( M, N )
122
IF( K.EQ.0 ) THEN
123
WORK( 1 ) = 1
124
RETURN
125
END IF
126
*
127
NBMIN = 2
128
NX = 0
129
IWS = M
130
IF( NB.GT.1 .AND. NB.LT.K ) THEN
131
*
132
* Determine when to cross over from blocked to unblocked code.
133
*
134
NX = MAX( 0, ILAENV( 3, 'CGELQF', ' ', M, N, -1, -1 ) )
135
IF( NX.LT.K ) THEN
136
*
137
* Determine if workspace is large enough for blocked code.
138
*
139
LDWORK = M
140
IWS = LDWORK*NB
141
IF( LWORK.LT.IWS ) THEN
142
*
143
* Not enough workspace to use optimal NB: reduce NB and
144
* determine the minimum value of NB.
145
*
146
NB = LWORK / LDWORK
147
NBMIN = MAX( 2, ILAENV( 2, 'CGELQF', ' ', M, N, -1,
148
$ -1 ) )
149
END IF
150
END IF
151
END IF
152
*
153
IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
154
*
155
* Use blocked code initially
156
*
157
DO 10 I = 1, K - NX, NB
158
IB = MIN( K-I+1, NB )
159
*
160
* Compute the LQ factorization of the current block
161
* A(i:i+ib-1,i:n)
162
*
163
CALL CGELQ2( IB, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
164
$ IINFO )
165
IF( I+IB.LE.M ) THEN
166
*
167
* Form the triangular factor of the block reflector
168
* H = H(i) H(i+1) . . . H(i+ib-1)
169
*
170
CALL CLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
171
$ LDA, TAU( I ), WORK, LDWORK )
172
*
173
* Apply H to A(i+ib:m,i:n) from the right
174
*
175
CALL CLARFB( 'Right', 'No transpose', 'Forward',
176
$ 'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ),
177
$ LDA, WORK, LDWORK, A( I+IB, I ), LDA,
178
$ WORK( IB+1 ), LDWORK )
179
END IF
180
10 CONTINUE
181
ELSE
182
I = 1
183
END IF
184
*
185
* Use unblocked code to factor the last or only block.
186
*
187
IF( I.LE.K )
188
$ CALL CGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
189
$ IINFO )
190
*
191
WORK( 1 ) = IWS
192
RETURN
193
*
194
* End of CGELQF
195
*
196
END
197
198