Skip to content

Commit 35b3758

Browse files
jprhynejprhyne
committed
implement zlarf1l and use it in relevant routines. TODO: update comments and cleanup
1 parent b69186b commit 35b3758

30 files changed

+516
-299
lines changed

‎SRC/CMakeLists.txt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -418,7 +418,7 @@ set(ZLASRC
418418
zlaqhb.f zlaqhe.f zlaqhp.f zlaqp2.f zlaqps.f zlaqp2rk.f zlaqp3rk.f zlaqsb.f
419419
zlaqr0.f zlaqr1.f zlaqr2.f zlaqr3.f zlaqr4.f zlaqr5.f
420420
zlaqsp.f zlaqsy.f zlar1v.f zlar2v.f ilazlr.f ilazlc.f
421-
zlarcm.f zlarf.f zlarfb.f zlarfb_gett.f zlarf1f.f
421+
zlarcm.f zlarf.f zlarfb.f zlarfb_gett.f zlarf1f.f zlarf1l.f
422422
zlarfg.f zlarfgp.f zlarft.f
423423
zlarfx.f zlarfy.f zlargv.f zlarnv.f zlarrv.f zlartg.f90 zlartv.f
424424
zlarz.f zlarzb.f zlarzt.f zlascl.f zlaset.f zlasr.f

‎SRC/Makefile

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -453,7 +453,7 @@ ZLASRC = \
453453
zlaqhb.o zlaqhe.o zlaqhp.o zlaqp2.o zlaqps.o zlaqp2rk.o zlaqp3rk.o zlaqsb.o \
454454
zlaqr0.o zlaqr1.o zlaqr2.o zlaqr3.o zlaqr4.o zlaqr5.o \
455455
zlaqsp.o zlaqsy.o zlar1v.o zlar2v.o ilazlr.o ilazlc.o \
456-
zlarcm.o zlarf.o zlarfb.o zlarfb_gett.o zlarf1f.o\
456+
zlarcm.o zlarf.o zlarfb.o zlarfb_gett.o zlarf1f.o zlarf1l.o \
457457
zlarfg.o zlarft.o zlarfgp.o \
458458
zlarfx.o zlarfy.o zlargv.o zlarnv.o zlarrv.o zlartg.o zlartv.o \
459459
zlarz.o zlarzb.o zlarzt.o zlascl.o zlaset.o zlasr.o \

‎SRC/zgebd2.f

Lines changed: 7 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -202,16 +202,14 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
202202
* =====================================================================
203203
*
204204
* .. Parameters ..
205-
COMPLEX*16 ZERO, ONE
206-
PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
207-
$ ONE = ( 1.0D+0, 0.0D+0 ) )
208-
* ..
205+
COMPLEX*16 ZERO
206+
PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
209207
* .. Local Scalars ..
210208
INTEGER I
211209
COMPLEX*16 ALPHA
212210
* ..
213211
* .. External Subroutines ..
214-
EXTERNAL XERBLA, ZLACGV, ZLARF, ZLARFG
212+
EXTERNAL XERBLA, ZLACGV, ZLARF1F, ZLARFG
215213
* ..
216214
* .. Intrinsic Functions ..
217215
INTRINSIC DCONJG, MAX, MIN
@@ -245,12 +243,11 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
245243
CALL ZLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
246244
$ TAUQ( I ) )
247245
D( I ) = DBLE( ALPHA )
248-
A( I, I ) = ONE
249246
*
250247
* Apply H(i)**H to A(i:m,i+1:n) from the left
251248
*
252249
IF( I.LT.N )
253-
$ CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
250+
$ CALL ZLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
254251
$ DCONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
255252
A( I, I ) = D( I )
256253
*
@@ -264,11 +261,10 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
264261
CALL ZLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ), LDA,
265262
$ TAUP( I ) )
266263
E( I ) = DBLE( ALPHA )
267-
A( I, I+1 ) = ONE
268264
*
269265
* Apply G(i) to A(i+1:m,i+1:n) from the right
270266
*
271-
CALL ZLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
267+
CALL ZLARF1F( 'Right', M-I, N-I, A( I, I+1 ), LDA,
272268
$ TAUP( I ), A( I+1, I+1 ), LDA, WORK )
273269
CALL ZLACGV( N-I, A( I, I+1 ), LDA )
274270
A( I, I+1 ) = E( I )
@@ -289,12 +285,11 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
289285
CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
290286
$ TAUP( I ) )
291287
D( I ) = DBLE( ALPHA )
292-
A( I, I ) = ONE
293288
*
294289
* Apply G(i) to A(i+1:m,i:n) from the right
295290
*
296291
IF( I.LT.M )
297-
$ CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
292+
$ CALL ZLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
298293
$ TAUP( I ), A( I+1, I ), LDA, WORK )
299294
CALL ZLACGV( N-I+1, A( I, I ), LDA )
300295
A( I, I ) = D( I )
@@ -308,11 +303,10 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
308303
CALL ZLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
309304
$ TAUQ( I ) )
310305
E( I ) = DBLE( ALPHA )
311-
A( I+1, I ) = ONE
312306
*
313307
* Apply H(i)**H to A(i+1:m,i+1:n) from the left
314308
*
315-
CALL ZLARF( 'Left', M-I, N-I, A( I+1, I ), 1,
309+
CALL ZLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1,
316310
$ DCONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
317311
$ WORK )
318312
A( I+1, I ) = E( I )

‎SRC/zgehd2.f

Lines changed: 6 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -169,7 +169,7 @@ SUBROUTINE ZGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
169169
COMPLEX*16 ALPHA
170170
* ..
171171
* .. External Subroutines ..
172-
EXTERNAL XERBLA, ZLARF, ZLARFG
172+
EXTERNAL XERBLA, ZLARF1F, ZLARFG
173173
* ..
174174
* .. Intrinsic Functions ..
175175
INTRINSIC DCONJG, MAX, MIN
@@ -197,22 +197,19 @@ SUBROUTINE ZGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
197197
*
198198
* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
199199
*
200-
ALPHA = A( I+1, I )
201-
CALL ZLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1,
200+
CALL ZLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
202201
$ TAU( I ) )
203-
A( I+1, I ) = ONE
204202
*
205203
* Apply H(i) to A(1:ihi,i+1:ihi) from the right
206204
*
207-
CALL ZLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
208-
$ A( 1, I+1 ), LDA, WORK )
205+
CALL ZLARF1F( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
206+
$ A( 1, I+1 ), LDA, WORK )
209207
*
210208
* Apply H(i)**H to A(i+1:ihi,i+1:n) from the left
211209
*
212-
CALL ZLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1,
213-
$ DCONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
210+
CALL ZLARF1F( 'Left', IHI-I, N-I, A( I+1, I ), 1,
211+
$ CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
214212
*
215-
A( I+1, I ) = ALPHA
216213
10 CONTINUE
217214
*
218215
RETURN

‎SRC/zgelq2.f

Lines changed: 5 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -149,7 +149,7 @@ SUBROUTINE ZGELQ2( M, N, A, LDA, TAU, WORK, INFO )
149149
COMPLEX*16 ALPHA
150150
* ..
151151
* .. External Subroutines ..
152-
EXTERNAL XERBLA, ZLACGV, ZLARF, ZLARFG
152+
EXTERNAL XERBLA, ZLACGV, ZLARF1F, ZLARFG
153153
* ..
154154
* .. Intrinsic Functions ..
155155
INTRINSIC MAX, MIN
@@ -178,19 +178,16 @@ SUBROUTINE ZGELQ2( M, N, A, LDA, TAU, WORK, INFO )
178178
* Generate elementary reflector H(i) to annihilate A(i,i+1:n)
179179
*
180180
CALL ZLACGV( N-I+1, A( I, I ), LDA )
181-
ALPHA = A( I, I )
182-
CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
181+
CALL ZLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
183182
$ TAU( I ) )
184183
IF( I.LT.M ) THEN
185184
*
186185
* Apply H(i) to A(i+1:m,i:n) from the right
187186
*
188-
A( I, I ) = ONE
189-
CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
190-
$ TAU( I ),
191-
$ A( I+1, I ), LDA, WORK )
187+
CALL ZLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
188+
$ TAU( I ),
189+
$ A( I+1, I ), LDA, WORK )
192190
END IF
193-
A( I, I ) = ALPHA
194191
CALL ZLACGV( N-I+1, A( I, I ), LDA )
195192
10 CONTINUE
196193
RETURN

‎SRC/zgeql2.f

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -172,15 +172,13 @@ SUBROUTINE ZGEQL2( M, N, A, LDA, TAU, WORK, INFO )
172172
* Generate elementary reflector H(i) to annihilate
173173
* A(1:m-k+i-1,n-k+i)
174174
*
175-
ALPHA = A( M-K+I, N-K+I )
176-
CALL ZLARFG( M-K+I, ALPHA, A( 1, N-K+I ), 1, TAU( I ) )
175+
CALL ZLARFG( M-K+I, A( M-K+I, N-K+I ), A( 1, N-K+I ), 1,
176+
$ TAU( I ) )
177177
*
178178
* Apply H(i)**H to A(1:m-k+i,1:n-k+i-1) from the left
179179
*
180-
A( M-K+I, N-K+I ) = ONE
181-
CALL ZLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1,
182-
$ DCONJG( TAU( I ) ), A, LDA, WORK )
183-
A( M-K+I, N-K+I ) = ALPHA
180+
CALL ZLARF1L( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1,
181+
$ CONJG( TAU( I ) ), A, LDA, WORK )
184182
10 CONTINUE
185183
RETURN
186184
*

‎SRC/zgeqr2.f

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -150,7 +150,7 @@ SUBROUTINE ZGEQR2( M, N, A, LDA, TAU, WORK, INFO )
150150
COMPLEX*16 ALPHA
151151
* ..
152152
* .. External Subroutines ..
153-
EXTERNAL XERBLA, ZLARF, ZLARFG
153+
EXTERNAL XERBLA, ZLARF1F, ZLARFG
154154
* ..
155155
* .. Intrinsic Functions ..
156156
INTRINSIC DCONJG, MAX, MIN
@@ -184,11 +184,8 @@ SUBROUTINE ZGEQR2( M, N, A, LDA, TAU, WORK, INFO )
184184
*
185185
* Apply H(i)**H to A(i:m,i+1:n) from the left
186186
*
187-
ALPHA = A( I, I )
188-
A( I, I ) = ONE
189-
CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
190-
$ DCONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
191-
A( I, I ) = ALPHA
187+
CALL ZLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
188+
$ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
192189
END IF
193190
10 CONTINUE
194191
RETURN

‎SRC/zgeqr2p.f

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -154,7 +154,7 @@ SUBROUTINE ZGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
154154
COMPLEX*16 ALPHA
155155
* ..
156156
* .. External Subroutines ..
157-
EXTERNAL XERBLA, ZLARF, ZLARFGP
157+
EXTERNAL XERBLA, ZLARF1F, ZLARFGP
158158
* ..
159159
* .. Intrinsic Functions ..
160160
INTRINSIC DCONJG, MAX, MIN
@@ -188,11 +188,8 @@ SUBROUTINE ZGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
188188
*
189189
* Apply H(i)**H to A(i:m,i+1:n) from the left
190190
*
191-
ALPHA = A( I, I )
192-
A( I, I ) = ONE
193-
CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
194-
$ DCONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
195-
A( I, I ) = ALPHA
191+
CALL ZLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
192+
$ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
196193
END IF
197194
10 CONTINUE
198195
RETURN

‎SRC/zgerq2.f

Lines changed: 5 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -143,7 +143,7 @@ SUBROUTINE ZGERQ2( M, N, A, LDA, TAU, WORK, INFO )
143143
COMPLEX*16 ALPHA
144144
* ..
145145
* .. External Subroutines ..
146-
EXTERNAL XERBLA, ZLACGV, ZLARF, ZLARFG
146+
EXTERNAL XERBLA, ZLACGV, ZLARF1L, ZLARFG
147147
* ..
148148
* .. Intrinsic Functions ..
149149
INTRINSIC MAX, MIN
@@ -173,15 +173,13 @@ SUBROUTINE ZGERQ2( M, N, A, LDA, TAU, WORK, INFO )
173173
* A(m-k+i,1:n-k+i-1)
174174
*
175175
CALL ZLACGV( N-K+I, A( M-K+I, 1 ), LDA )
176-
ALPHA = A( M-K+I, N-K+I )
177-
CALL ZLARFG( N-K+I, ALPHA, A( M-K+I, 1 ), LDA, TAU( I ) )
176+
CALL ZLARFG( N-K+I, A( M-K+I, N-K+I ), A( M-K+I, 1 ), LDA,
177+
$ TAU( I ) )
178178
*
179179
* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right
180180
*
181-
A( M-K+I, N-K+I ) = ONE
182-
CALL ZLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
183-
$ TAU( I ), A, LDA, WORK )
184-
A( M-K+I, N-K+I ) = ALPHA
181+
CALL ZLARF1L( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
182+
$ TAU( I ), A, LDA, WORK )
185183
CALL ZLACGV( N-K+I-1, A( M-K+I, 1 ), LDA )
186184
10 CONTINUE
187185
RETURN

‎SRC/zlaqp2.f

Lines changed: 4 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -174,7 +174,7 @@ SUBROUTINE ZLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
174174
COMPLEX*16 AII
175175
* ..
176176
* .. External Subroutines ..
177-
EXTERNAL ZLARF, ZLARFG, ZSWAP
177+
EXTERNAL ZLARF1F, ZLARFG, ZSWAP
178178
* ..
179179
* .. Intrinsic Functions ..
180180
INTRINSIC ABS, DCONJG, MAX, MIN, SQRT
@@ -222,12 +222,9 @@ SUBROUTINE ZLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
222222
*
223223
* Apply H(i)**H to A(offset+i:m,i+1:n) from the left.
224224
*
225-
AII = A( OFFPI, I )
226-
A( OFFPI, I ) = CONE
227-
CALL ZLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
228-
$ DCONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA,
229-
$ WORK( 1 ) )
230-
A( OFFPI, I ) = AII
225+
CALL ZLARF1F( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
226+
$ CONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA,
227+
$ WORK( 1 ) )
231228
END IF
232229
*
233230
* Update partial column norms.

0 commit comments

Comments
 (0)