Skip to content

Commit 2d8314f

Browse files
jprhynejprhyne
committed
updating double precision routines to use dlarf1f and dlarf1l. Still developing zlarf1f.f
1 parent 0be01da commit 2d8314f

28 files changed

+614
-183
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
421+
zlarcm.f zlarf.f zlarfb.f zlarfb_gett.f zlarf1f.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 \
456+
zlarcm.o zlarf.o zlarfb.o zlarfb_gett.o zlarf1f.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/dgebd2.f

Lines changed: 5 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -209,7 +209,7 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
209209
INTEGER I
210210
* ..
211211
* .. External Subroutines ..
212-
EXTERNAL DLARF, DLARFG, XERBLA
212+
EXTERNAL DLARF1F, DLARFG, XERBLA
213213
* ..
214214
* .. Intrinsic Functions ..
215215
INTRINSIC MAX, MIN
@@ -242,15 +242,13 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
242242
CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
243243
$ TAUQ( I ) )
244244
D( I ) = A( I, I )
245-
A( I, I ) = ONE
246245
*
247246
* Apply H(i) to A(i:m,i+1:n) from the left
248247
*
249248
IF( I.LT.N )
250-
$ CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
249+
$ CALL DLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
251250
$ TAUQ( I ),
252251
$ A( I, I+1 ), LDA, WORK )
253-
A( I, I ) = D( I )
254252
*
255253
IF( I.LT.N ) THEN
256254
*
@@ -260,13 +258,11 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
260258
CALL DLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
261259
$ LDA, TAUP( I ) )
262260
E( I ) = A( I, I+1 )
263-
A( I, I+1 ) = ONE
264261
*
265262
* Apply G(i) to A(i+1:m,i+1:n) from the right
266263
*
267-
CALL DLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
264+
CALL DLARF1F( 'Right', M-I, N-I, A( I, I+1 ), LDA,
268265
$ TAUP( I ), A( I+1, I+1 ), LDA, WORK )
269-
A( I, I+1 ) = E( I )
270266
ELSE
271267
TAUP( I ) = ZERO
272268
END IF
@@ -283,14 +279,12 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
283279
$ LDA,
284280
$ TAUP( I ) )
285281
D( I ) = A( I, I )
286-
A( I, I ) = ONE
287282
*
288283
* Apply G(i) to A(i+1:m,i:n) from the right
289284
*
290285
IF( I.LT.M )
291-
$ CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
286+
$ CALL DLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
292287
$ TAUP( I ), A( I+1, I ), LDA, WORK )
293-
A( I, I ) = D( I )
294288
*
295289
IF( I.LT.M ) THEN
296290
*
@@ -301,14 +295,12 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
301295
$ 1,
302296
$ TAUQ( I ) )
303297
E( I ) = A( I+1, I )
304-
A( I+1, I ) = ONE
305298
*
306299
* Apply H(i) to A(i+1:m,i+1:n) from the left
307300
*
308-
CALL DLARF( 'Left', M-I, N-I, A( I+1, I ), 1,
301+
CALL DLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1,
309302
$ TAUQ( I ),
310303
$ A( I+1, I+1 ), LDA, WORK )
311-
A( I+1, I ) = E( I )
312304
ELSE
313305
TAUQ( I ) = ZERO
314306
END IF

‎SRC/dgehd2.f

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -166,10 +166,9 @@ SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
166166
* ..
167167
* .. Local Scalars ..
168168
INTEGER I
169-
DOUBLE PRECISION AII
170169
* ..
171170
* .. External Subroutines ..
172-
EXTERNAL DLARF, DLARFG, XERBLA
171+
EXTERNAL DLARF1F, DLARFG, XERBLA
173172
* ..
174173
* .. Intrinsic Functions ..
175174
INTRINSIC MAX, MIN
@@ -199,20 +198,17 @@ SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
199198
*
200199
CALL DLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
201200
$ TAU( I ) )
202-
AII = A( I+1, I )
203-
A( I+1, I ) = ONE
204201
*
205202
* Apply H(i) to A(1:ihi,i+1:ihi) from the right
206203
*
207-
CALL DLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
204+
CALL DLARF1F( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
208205
$ A( 1, I+1 ), LDA, WORK )
209206
*
210207
* Apply H(i) to A(i+1:ihi,i+1:n) from the left
211208
*
212-
CALL DLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ),
209+
CALL DLARF1F( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ),
213210
$ A( I+1, I+1 ), LDA, WORK )
214211
*
215-
A( I+1, I ) = AII
216212
10 CONTINUE
217213
*
218214
RETURN

‎SRC/dgelq2.f

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -146,10 +146,9 @@ SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
146146
* ..
147147
* .. Local Scalars ..
148148
INTEGER I, K
149-
DOUBLE PRECISION AII
150149
* ..
151150
* .. External Subroutines ..
152-
EXTERNAL DLARF, DLARFG, XERBLA
151+
EXTERNAL DLARF1F, DLARFG, XERBLA
153152
* ..
154153
* .. Intrinsic Functions ..
155154
INTRINSIC MAX, MIN
@@ -183,12 +182,9 @@ SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
183182
*
184183
* Apply H(i) to A(i+1:m,i:n) from the right
185184
*
186-
AII = A( I, I )
187-
A( I, I ) = ONE
188-
CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
185+
CALL DLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
189186
$ TAU( I ),
190187
$ A( I+1, I ), LDA, WORK )
191-
A( I, I ) = AII
192188
END IF
193189
10 CONTINUE
194190
RETURN

‎SRC/dgeql2.f

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -140,10 +140,9 @@ SUBROUTINE DGEQL2( M, N, A, LDA, TAU, WORK, INFO )
140140
* ..
141141
* .. Local Scalars ..
142142
INTEGER I, K
143-
DOUBLE PRECISION AII
144143
* ..
145144
* .. External Subroutines ..
146-
EXTERNAL DLARF, DLARFG, XERBLA
145+
EXTERNAL DLARF1L, DLARFG, XERBLA
147146
* ..
148147
* .. Intrinsic Functions ..
149148
INTRINSIC MAX, MIN
@@ -177,12 +176,9 @@ SUBROUTINE DGEQL2( M, N, A, LDA, TAU, WORK, INFO )
177176
*
178177
* Apply H(i) to A(1:m-k+i,1:n-k+i-1) from the left
179178
*
180-
AII = A( M-K+I, N-K+I )
181-
A( M-K+I, N-K+I ) = ONE
182-
CALL DLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1,
179+
CALL DLARF1L( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1,
183180
$ TAU( I ),
184181
$ A, LDA, WORK )
185-
A( M-K+I, N-K+I ) = AII
186182
10 CONTINUE
187183
RETURN
188184
*

‎SRC/dgeqr2.f

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -147,10 +147,9 @@ SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
147147
* ..
148148
* .. Local Scalars ..
149149
INTEGER I, K
150-
DOUBLE PRECISION AII
151150
* ..
152151
* .. External Subroutines ..
153-
EXTERNAL DLARF, DLARFG, XERBLA
152+
EXTERNAL DLARF1F, DLARFG, XERBLA
154153
* ..
155154
* .. Intrinsic Functions ..
156155
INTRINSIC MAX, MIN
@@ -184,11 +183,8 @@ SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
184183
*
185184
* Apply H(i) to A(i:m,i+1:n) from the left
186185
*
187-
AII = A( I, I )
188-
A( I, I ) = ONE
189-
CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
186+
CALL DLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
190187
$ A( I, I+1 ), LDA, WORK )
191-
A( I, I ) = AII
192188
END IF
193189
10 CONTINUE
194190
RETURN

‎SRC/dgeqr2p.f

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -151,10 +151,9 @@ SUBROUTINE DGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
151151
* ..
152152
* .. Local Scalars ..
153153
INTEGER I, K
154-
DOUBLE PRECISION AII
155154
* ..
156155
* .. External Subroutines ..
157-
EXTERNAL DLARF, DLARFGP, XERBLA
156+
EXTERNAL DLARF1F, DLARFGP, XERBLA
158157
* ..
159158
* .. Intrinsic Functions ..
160159
INTRINSIC MAX, MIN
@@ -188,11 +187,8 @@ SUBROUTINE DGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
188187
*
189188
* Apply H(i) to A(i:m,i+1:n) from the left
190189
*
191-
AII = A( I, I )
192-
A( I, I ) = ONE
193-
CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
190+
CALL DLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
194191
$ A( I, I+1 ), LDA, WORK )
195-
A( I, I ) = AII
196192
END IF
197193
10 CONTINUE
198194
RETURN

‎SRC/dgerq2.f

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -140,10 +140,9 @@ SUBROUTINE DGERQ2( M, N, A, LDA, TAU, WORK, INFO )
140140
* ..
141141
* .. Local Scalars ..
142142
INTEGER I, K
143-
DOUBLE PRECISION AII
144143
* ..
145144
* .. External Subroutines ..
146-
EXTERNAL DLARF, DLARFG, XERBLA
145+
EXTERNAL DLARF1L, DLARFG, XERBLA
147146
* ..
148147
* .. Intrinsic Functions ..
149148
INTRINSIC MAX, MIN
@@ -177,11 +176,8 @@ SUBROUTINE DGERQ2( M, N, A, LDA, TAU, WORK, INFO )
177176
*
178177
* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right
179178
*
180-
AII = A( M-K+I, N-K+I )
181-
A( M-K+I, N-K+I ) = ONE
182-
CALL DLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
179+
CALL DLARF1L( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
183180
$ TAU( I ), A, LDA, WORK )
184-
A( M-K+I, N-K+I ) = AII
185181
10 CONTINUE
186182
RETURN
187183
*

‎SRC/dlaqp2.f

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -168,7 +168,7 @@ SUBROUTINE DLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
168168
* ..
169169
* .. Local Scalars ..
170170
INTEGER I, ITEMP, J, MN, OFFPI, PVT
171-
DOUBLE PRECISION AII, TEMP, TEMP2, TOL3Z
171+
DOUBLE PRECISION TEMP, TEMP2, TOL3Z
172172
* ..
173173
* .. External Subroutines ..
174174
EXTERNAL DLARF, DLARFG, DSWAP
@@ -219,11 +219,8 @@ SUBROUTINE DLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
219219
*
220220
* Apply H(i)**T to A(offset+i:m,i+1:n) from the left.
221221
*
222-
AII = A( OFFPI, I )
223-
A( OFFPI, I ) = ONE
224-
CALL DLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
222+
CALL DLARF1F( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
225223
$ TAU( I ), A( OFFPI, I+1 ), LDA, WORK( 1 ) )
226-
A( OFFPI, I ) = AII
227224
END IF
228225
*
229226
* Update partial column norms.

0 commit comments

Comments
 (0)