Skip to content

Commit 8ed1ab5

Browse files
EduardFedorenkovEduardFedorenkov
committed
update single complex routines to use clarf1f and clarf1l, #1011 
1 parent b8b9771 commit 8ed1ab5

26 files changed

+228
-358
lines changed

‎SRC/cgebd2.f

Lines changed: 13 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -203,16 +203,15 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
203203
* =====================================================================
204204
*
205205
* .. Parameters ..
206-
COMPLEX ZERO, ONE
207-
PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ),
208-
$ ONE = ( 1.0E+0, 0.0E+0 ) )
206+
COMPLEX ZERO
207+
PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) )
209208
* ..
210209
* .. Local Scalars ..
211210
INTEGER I
212211
COMPLEX ALPHA
213212
* ..
214213
* .. External Subroutines ..
215-
EXTERNAL CLACGV, CLARF, CLARFG, XERBLA
214+
EXTERNAL CLACGV, CLARF1F, CLARFG, XERBLA
216215
* ..
217216
* .. Intrinsic Functions ..
218217
INTRINSIC CONJG, MAX, MIN
@@ -246,13 +245,13 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
246245
CALL CLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
247246
$ TAUQ( I ) )
248247
D( I ) = REAL( ALPHA )
249-
A( I, I ) = ONE
250248
*
251249
* Apply H(i)**H to A(i:m,i+1:n) from the left
252250
*
253251
IF( I.LT.N )
254-
$ CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
255-
$ CONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
252+
$ CALL CLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
253+
$ CONJG( TAUQ( I ) ), A( I, I+1 ), LDA,
254+
$ WORK )
256255
A( I, I ) = D( I )
257256
*
258257
IF( I.LT.N ) THEN
@@ -265,12 +264,11 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
265264
CALL CLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ),
266265
$ LDA, TAUP( I ) )
267266
E( I ) = REAL( ALPHA )
268-
A( I, I+1 ) = ONE
269267
*
270268
* Apply G(i) to A(i+1:m,i+1:n) from the right
271269
*
272-
CALL CLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
273-
$ TAUP( I ), A( I+1, I+1 ), LDA, WORK )
270+
CALL CLARF1F( 'Right', M-I, N-I, A( I, I+1 ), LDA,
271+
$ TAUP( I ), A( I+1, I+1 ), LDA, WORK )
274272
CALL CLACGV( N-I, A( I, I+1 ), LDA )
275273
A( I, I+1 ) = E( I )
276274
ELSE
@@ -290,13 +288,12 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
290288
CALL CLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
291289
$ TAUP( I ) )
292290
D( I ) = REAL( ALPHA )
293-
A( I, I ) = ONE
294291
*
295292
* Apply G(i) to A(i+1:m,i:n) from the right
296293
*
297294
IF( I.LT.M )
298-
$ CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
299-
$ TAUP( I ), A( I+1, I ), LDA, WORK )
295+
$ CALL CLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
296+
$ TAUP( I ), A( I+1, I ), LDA, WORK )
300297
CALL CLACGV( N-I+1, A( I, I ), LDA )
301298
A( I, I ) = D( I )
302299
*
@@ -309,13 +306,12 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
309306
CALL CLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
310307
$ TAUQ( I ) )
311308
E( I ) = REAL( ALPHA )
312-
A( I+1, I ) = ONE
313309
*
314310
* Apply H(i)**H to A(i+1:m,i+1:n) from the left
315311
*
316-
CALL CLARF( 'Left', M-I, N-I, A( I+1, I ), 1,
317-
$ CONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
318-
$ WORK )
312+
CALL CLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1,
313+
$ CONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
314+
$ WORK )
319315
A( I+1, I ) = E( I )
320316
ELSE
321317
TAUQ( I ) = ZERO

‎SRC/cgehd2.f

Lines changed: 6 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -160,16 +160,11 @@ SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
160160
*
161161
* =====================================================================
162162
*
163-
* .. Parameters ..
164-
COMPLEX ONE
165-
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
166-
* ..
167163
* .. Local Scalars ..
168164
INTEGER I
169-
COMPLEX ALPHA
170165
* ..
171166
* .. External Subroutines ..
172-
EXTERNAL CLARF, CLARFG, XERBLA
167+
EXTERNAL CLARF1F, CLARFG, XERBLA
173168
* ..
174169
* .. Intrinsic Functions ..
175170
INTRINSIC CONJG, MAX, MIN
@@ -197,22 +192,19 @@ SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
197192
*
198193
* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
199194
*
200-
ALPHA = A( I+1, I )
201-
CALL CLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1,
195+
CALL CLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
202196
$ TAU( I ) )
203-
A( I+1, I ) = ONE
204197
*
205198
* Apply H(i) to A(1:ihi,i+1:ihi) from the right
206199
*
207-
CALL CLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
208-
$ A( 1, I+1 ), LDA, WORK )
200+
CALL CLARF1F( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
201+
$ A( 1, I+1 ), LDA, WORK )
209202
*
210203
* Apply H(i)**H to A(i+1:ihi,i+1:n) from the left
211204
*
212-
CALL CLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1,
213-
$ CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
205+
CALL CLARF1F( 'Left', IHI-I, N-I, A( I+1, I ), 1,
206+
$ CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
214207
*
215-
A( I+1, I ) = ALPHA
216208
10 CONTINUE
217209
*
218210
RETURN

‎SRC/cgelq2.f

Lines changed: 5 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -140,16 +140,11 @@ SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO )
140140
*
141141
* =====================================================================
142142
*
143-
* .. Parameters ..
144-
COMPLEX ONE
145-
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
146-
* ..
147143
* .. Local Scalars ..
148144
INTEGER I, K
149-
COMPLEX ALPHA
150145
* ..
151146
* .. External Subroutines ..
152-
EXTERNAL CLACGV, CLARF, CLARFG, XERBLA
147+
EXTERNAL CLACGV, CLARF1F, CLARFG, XERBLA
153148
* ..
154149
* .. Intrinsic Functions ..
155150
INTRINSIC MAX, MIN
@@ -178,19 +173,16 @@ SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO )
178173
* Generate elementary reflector H(i) to annihilate A(i,i+1:n)
179174
*
180175
CALL CLACGV( N-I+1, A( I, I ), LDA )
181-
ALPHA = A( I, I )
182-
CALL CLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
176+
CALL CLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
183177
$ TAU( I ) )
184178
IF( I.LT.M ) THEN
185179
*
186180
* Apply H(i) to A(i+1:m,i:n) from the right
187181
*
188-
A( I, I ) = ONE
189-
CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
190-
$ TAU( I ),
191-
$ A( I+1, I ), LDA, WORK )
182+
CALL CLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
183+
$ TAU( I ),
184+
$ A( I+1, I ), LDA, WORK )
192185
END IF
193-
A( I, I ) = ALPHA
194186
CALL CLACGV( N-I+1, A( I, I ), LDA )
195187
10 CONTINUE
196188
RETURN

‎SRC/cgeql2.f

Lines changed: 5 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -134,16 +134,11 @@ SUBROUTINE CGEQL2( M, N, A, LDA, TAU, WORK, INFO )
134134
*
135135
* =====================================================================
136136
*
137-
* .. Parameters ..
138-
COMPLEX ONE
139-
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
140-
* ..
141137
* .. Local Scalars ..
142138
INTEGER I, K
143-
COMPLEX ALPHA
144139
* ..
145140
* .. External Subroutines ..
146-
EXTERNAL CLARF, CLARFG, XERBLA
141+
EXTERNAL CLARF1L, CLARFG, XERBLA
147142
* ..
148143
* .. Intrinsic Functions ..
149144
INTRINSIC CONJG, MAX, MIN
@@ -172,15 +167,13 @@ SUBROUTINE CGEQL2( M, N, A, LDA, TAU, WORK, INFO )
172167
* Generate elementary reflector H(i) to annihilate
173168
* A(1:m-k+i-1,n-k+i)
174169
*
175-
ALPHA = A( M-K+I, N-K+I )
176-
CALL CLARFG( M-K+I, ALPHA, A( 1, N-K+I ), 1, TAU( I ) )
170+
CALL CLARFG( M-K+I, A( M-K+I, N-K+I ), A( 1, N-K+I ), 1,
171+
$ TAU( I ) )
177172
*
178173
* Apply H(i)**H to A(1:m-k+i,1:n-k+i-1) from the left
179174
*
180-
A( M-K+I, N-K+I ) = ONE
181-
CALL CLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1,
182-
$ CONJG( TAU( I ) ), A, LDA, WORK )
183-
A( M-K+I, N-K+I ) = ALPHA
175+
CALL CLARF1L( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1,
176+
$ CONJG( TAU( I ) ), A, LDA, WORK )
184177
10 CONTINUE
185178
RETURN
186179
*

‎SRC/cgeqp3rk.f

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -678,7 +678,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
678678
* Minimal workspace size in case of using only unblocked
679679
* BLAS 2 code in CLAQP2RK.
680680
* 1) CLAQP2RK: N+NRHS-1 to use in WORK array that is used
681-
* in CLARF subroutine inside CLAQP2RK to apply an
681+
* in CLARF1F subroutine inside CLAQP2RK to apply an
682682
* elementary reflector from the left.
683683
* TOTAL_WORK_SIZE = 3*N + NRHS - 1
684684
*
@@ -694,7 +694,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
694694
* 1) CGEQP3RK, CLAQP2RK, CLAQP3RK: 2*N to store full and
695695
* partial column 2-norms.
696696
* 2) CLAQP2RK: N+NRHS-1 to use in WORK array that is used
697-
* in CLARF subroutine to apply an elementary reflector
697+
* in CLARF1F subroutine to apply an elementary reflector
698698
* from the left.
699699
* 3) CLAQP3RK: NB*(N+NRHS) to use in the work array F that
700700
* is used to apply a block reflector from

‎SRC/cgeqr2.f

Lines changed: 3 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -141,16 +141,11 @@ SUBROUTINE CGEQR2( M, N, A, LDA, TAU, WORK, INFO )
141141
*
142142
* =====================================================================
143143
*
144-
* .. Parameters ..
145-
COMPLEX ONE
146-
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
147-
* ..
148144
* .. Local Scalars ..
149145
INTEGER I, K
150-
COMPLEX ALPHA
151146
* ..
152147
* .. External Subroutines ..
153-
EXTERNAL CLARF, CLARFG, XERBLA
148+
EXTERNAL CLARF1F, CLARFG, XERBLA
154149
* ..
155150
* .. Intrinsic Functions ..
156151
INTRINSIC CONJG, MAX, MIN
@@ -184,11 +179,8 @@ SUBROUTINE CGEQR2( M, N, A, LDA, TAU, WORK, INFO )
184179
*
185180
* Apply H(i)**H to A(i:m,i+1:n) from the left
186181
*
187-
ALPHA = A( I, I )
188-
A( I, I ) = ONE
189-
CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
190-
$ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
191-
A( I, I ) = ALPHA
182+
CALL CLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
183+
$ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
192184
END IF
193185
10 CONTINUE
194186
RETURN

‎SRC/cgeqr2p.f

Lines changed: 3 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -145,16 +145,11 @@ SUBROUTINE CGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
145145
*
146146
* =====================================================================
147147
*
148-
* .. Parameters ..
149-
COMPLEX ONE
150-
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
151-
* ..
152148
* .. Local Scalars ..
153149
INTEGER I, K
154-
COMPLEX ALPHA
155150
* ..
156151
* .. External Subroutines ..
157-
EXTERNAL CLARF, CLARFGP, XERBLA
152+
EXTERNAL CLARF1F, CLARFGP, XERBLA
158153
* ..
159154
* .. Intrinsic Functions ..
160155
INTRINSIC CONJG, MAX, MIN
@@ -188,11 +183,8 @@ SUBROUTINE CGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
188183
*
189184
* Apply H(i)**H to A(i:m,i+1:n) from the left
190185
*
191-
ALPHA = A( I, I )
192-
A( I, I ) = ONE
193-
CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
194-
$ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
195-
A( I, I ) = ALPHA
186+
CALL CLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
187+
$ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
196188
END IF
197189
10 CONTINUE
198190
RETURN

‎SRC/cgerq2.f

Lines changed: 4 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -134,16 +134,11 @@ SUBROUTINE CGERQ2( M, N, A, LDA, TAU, WORK, INFO )
134134
*
135135
* =====================================================================
136136
*
137-
* .. Parameters ..
138-
COMPLEX ONE
139-
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
140-
* ..
141137
* .. Local Scalars ..
142138
INTEGER I, K
143-
COMPLEX ALPHA
144139
* ..
145140
* .. External Subroutines ..
146-
EXTERNAL CLACGV, CLARF, CLARFG, XERBLA
141+
EXTERNAL CLACGV, CLARF1L, CLARFG, XERBLA
147142
* ..
148143
* .. Intrinsic Functions ..
149144
INTRINSIC MAX, MIN
@@ -173,16 +168,13 @@ SUBROUTINE CGERQ2( M, N, A, LDA, TAU, WORK, INFO )
173168
* A(m-k+i,1:n-k+i-1)
174169
*
175170
CALL CLACGV( N-K+I, A( M-K+I, 1 ), LDA )
176-
ALPHA = A( M-K+I, N-K+I )
177-
CALL CLARFG( N-K+I, ALPHA, A( M-K+I, 1 ), LDA,
171+
CALL CLARFG( N-K+I, A( M-K+I, N-K+I ), A( M-K+I, 1 ), LDA,
178172
$ TAU( I ) )
179173
*
180174
* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right
181175
*
182-
A( M-K+I, N-K+I ) = ONE
183-
CALL CLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
184-
$ TAU( I ), A, LDA, WORK )
185-
A( M-K+I, N-K+I ) = ALPHA
176+
CALL CLARF1L( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
177+
$ TAU( I ), A, LDA, WORK )
186178
CALL CLACGV( N-K+I-1, A( M-K+I, 1 ), LDA )
187179
10 CONTINUE
188180
RETURN

‎SRC/claqp2.f

Lines changed: 5 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -164,17 +164,14 @@ SUBROUTINE CLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
164164
*
165165
* .. Parameters ..
166166
REAL ZERO, ONE
167-
COMPLEX CONE
168-
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0,
169-
$ CONE = ( 1.0E+0, 0.0E+0 ) )
167+
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
170168
* ..
171169
* .. Local Scalars ..
172170
INTEGER I, ITEMP, J, MN, OFFPI, PVT
173171
REAL TEMP, TEMP2, TOL3Z
174-
COMPLEX AII
175172
* ..
176173
* .. External Subroutines ..
177-
EXTERNAL CLARF, CLARFG, CSWAP
174+
EXTERNAL CLARF1F, CLARFG, CSWAP
178175
* ..
179176
* .. Intrinsic Functions ..
180177
INTRINSIC ABS, CONJG, MAX, MIN, SQRT
@@ -222,12 +219,9 @@ SUBROUTINE CLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
222219
*
223220
* Apply H(i)**H to A(offset+i:m,i+1:n) from the left.
224221
*
225-
AII = A( OFFPI, I )
226-
A( OFFPI, I ) = CONE
227-
CALL CLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
228-
$ CONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA,
229-
$ WORK( 1 ) )
230-
A( OFFPI, I ) = AII
222+
CALL CLARF1F( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
223+
$ CONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA,
224+
$ WORK( 1 ) )
231225
END IF
232226
*
233227
* Update partial column norms.

0 commit comments

Comments
 (0)