Skip to content

Commit 256c836

Browse files
langoulangou
authored
Merge pull request #1019 from EduardFedorenkov/1011-add-larf1f-and-larf1l-in-lapack
develop DLARF1F and implement in ORM2R, #1011
2 parents 2121711 + c8b1a51 commit 256c836

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

59 files changed

+1463
-730
lines changed

‎SRC/CMakeLists.txt‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -106,7 +106,7 @@ set(SLASRC
106106
slaqgb.f slaqge.f slaqp2.f slaqps.f slaqp2rk.f slaqp3rk.f slaqsb.f slaqsp.f slaqsy.f
107107
slaqr0.f slaqr1.f slaqr2.f slaqr3.f slaqr4.f slaqr5.f
108108
slaqtr.f slar1v.f slar2v.f ilaslr.f ilaslc.f
109-
slarf.f slarfb.f slarfb_gett.f slarfg.f slarfgp.f slarft.f slarfx.f slarfy.f
109+
slarf.f slarf1f.f slarf1l.f slarfb.f slarfb_gett.f slarfg.f slarfgp.f slarft.f slarfx.f slarfy.f
110110
slargv.f slarmm.f slarrv.f slartv.f
111111
slarz.f slarzb.f slarzt.f slasy2.f
112112
slasyf.f slasyf_rook.f slasyf_rk.f slasyf_aa.f
@@ -218,7 +218,7 @@ set(CLASRC
218218
claqhb.f claqhe.f claqhp.f claqp2.f claqps.f claqp2rk.f claqp3rk.f claqsb.f
219219
claqr0.f claqr1.f claqr2.f claqr3.f claqr4.f claqr5.f
220220
claqsp.f claqsy.f clar1v.f clar2v.f ilaclr.f ilaclc.f
221-
clarf.f clarfb.f clarfb_gett.f clarfg.f clarfgp.f clarft.f
221+
clarf.f clarf1f.f clarf1l.f clarfb.f clarfb_gett.f clarfg.f clarfgp.f clarft.f
222222
clarfx.f clarfy.f clargv.f clarnv.f clarrv.f clartg.f90 clartv.f
223223
clarz.f clarzb.f clarzt.f clascl.f claset.f clasr.f classq.f90
224224
claswp.f clasyf.f clasyf_rook.f clasyf_rk.f clasyf_aa.f

‎SRC/Makefile‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -137,7 +137,7 @@ SLASRC = \
137137
slaqgb.o slaqge.o slaqp2.o slaqps.o slaqp2rk.o slaqp3rk.o slaqsb.o slaqsp.o slaqsy.o \
138138
slaqr0.o slaqr1.o slaqr2.o slaqr3.o slaqr4.o slaqr5.o \
139139
slaqtr.o slar1v.o slar2v.o ilaslr.o ilaslc.o \
140-
slarf.o slarfb.o slarfb_gett.o slarfg.o slarfgp.o slarft.o slarfx.o slarfy.o \
140+
slarf.o slarf1f.o slarf1l.o slarfb.o slarfb_gett.o slarfg.o slarfgp.o slarft.o slarfx.o slarfy.o \
141141
slargv.o slarmm.o slarrv.o slartv.o \
142142
slarz.o slarzb.o slarzt.o slaswp.o slasy2.o slasyf.o slasyf_rook.o \
143143
slasyf_rk.o \
@@ -249,7 +249,7 @@ CLASRC = \
249249
claqhb.o claqhe.o claqhp.o claqp2.o claqps.o claqp2rk.o claqp3rk.o claqsb.o \
250250
claqr0.o claqr1.o claqr2.o claqr3.o claqr4.o claqr5.o \
251251
claqsp.o claqsy.o clar1v.o clar2v.o ilaclr.o ilaclc.o \
252-
clarf.o clarfb.o clarfb_gett.o clarfg.o clarft.o clarfgp.o \
252+
clarf.o clarf1f.o clarf1l.o clarfb.o clarfb_gett.o clarfg.o clarft.o clarfgp.o \
253253
clarfx.o clarfy.o clargv.o clarnv.o clarrv.o clartg.o clartv.o \
254254
clarz.o clarzb.o clarzt.o clascl.o claset.o clasr.o classq.o \
255255
claswp.o clasyf.o clasyf_rook.o clasyf_rk.o clasyf_aa.o \

‎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: 4 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,15 @@ 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 ), A( I+1, I ), LDA, WORK )
192184
END IF
193-
A( I, I ) = ALPHA
194185
CALL CLACGV( N-I+1, A( I, I ), LDA )
195186
10 CONTINUE
196187
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

0 commit comments

Comments
 (0)