Skip to content

Commit 9a51a35

Browse files
jprhynejprhyne
committed
fixing compilation errors in test suite
1 parent 57b267c commit 9a51a35

File tree

5 files changed

+41
-41
lines changed

5 files changed

+41
-41
lines changed

‎SRC/dorbdb.f‎

Lines changed: 13 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -440,13 +440,12 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12,
440440
$ X12(I,I), LDX12, WORK )
441441
END IF
442442
IF ( Q .GT. I ) THEN
443-
CALL DLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
444-
$ X21(I,I+1), LDX21, WORK )
443+
CALL DLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1,
444+
$ TAUP2(I), X21(I,I+1), LDX21, WORK )
445445
END IF
446446
IF ( M-Q+1 .GT. I ) THEN
447447
CALL DLARF1F( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1,
448-
$ TAUP2(I),
449-
$ X22(I,I), LDX22, WORK )
448+
$ TAUP2(I), X22(I,I), LDX22, WORK )
450449
END IF
451450
*
452451
IF( I .LT. Q ) THEN
@@ -638,15 +637,14 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12,
638637
IF( I .LT. Q ) THEN
639638
CALL DLARF1F( 'L', Q-I, P-I, X11(I+1,I), 1, TAUQ1(I),
640639
$ X11(I+1,I+1), LDX11, WORK )
641-
CALL DLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1, TAUQ1(I),
642-
$ X21(I+1,I+1), LDX21, WORK )
640+
CALL DLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1,
641+
$ TAUQ1(I), X21(I+1,I+1), LDX21, WORK )
643642
END IF
644643
CALL DLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),
645-
$ X12(I,I+1), LDX12, WORK )
644+
$ X12(I,I+1), LDX12, WORK )
646645
IF ( M-P-I .GT. 0 ) THEN
647646
CALL DLARF1F( 'L', M-Q-I+1, M-P-I, X12(I,I), 1,
648-
$ TAUQ2(I),
649-
$ X22(I,I+1), LDX22, WORK )
647+
$ TAUQ2(I), X22(I,I+1), LDX22, WORK )
650648
END IF
651649
*
652650
END DO
@@ -660,13 +658,12 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12,
660658
$ TAUQ2(I) )
661659
*
662660
IF ( P .GT. I ) THEN
663-
CALL DLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),
664-
$ X12(I,I+1), LDX12, WORK )
661+
CALL DLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1,
662+
$ TAUQ2(I), X12(I,I+1), LDX12, WORK )
665663
END IF
666664
IF( M-P-Q .GE. 1 )
667665
$ CALL DLARF1F( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1,
668-
$ TAUQ2(I),
669-
$ X22(I,Q+1), LDX22, WORK )
666+
$ TAUQ2(I), X22(I,Q+1), LDX22, WORK )
670667
*
671668
END DO
672669
*
@@ -683,8 +680,9 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12,
683680
CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I),
684681
$ 1,
685682
$ TAUQ2(P+I) )
686-
CALL DLARF1F( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1,
687-
$ TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, WORK )
683+
CALL DLARF1F( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I),
684+
$ 1, TAUQ2(P+I), X22(P+I,Q+I+1), LDX22,
685+
$ WORK )
688686
END IF
689687
*
690688
END DO

‎SRC/dorbdb1.f‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -301,8 +301,9 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA,
301301
S = X21(I,I+1)
302302
CALL DLARF1F( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I),
303303
$ X11(I+1,I+1), LDX11, WORK(ILARF) )
304-
CALL DLARF1F( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I),
305-
$ X21(I+1,I+1), LDX21, WORK(ILARF) )
304+
CALL DLARF1F( 'R', M-P-I, Q-I, X21(I,I+1), LDX21,
305+
$ TAUQ1(I), X21(I+1,I+1), LDX21,
306+
$ WORK(ILARF) )
306307
C = SQRT( DNRM2( P-I, X11(I+1,I+1), 1 )**2
307308
$ + DNRM2( M-P-I, X21(I+1,I+1), 1 )**2 )
308309
PHI(I) = ATAN2( S, C )

‎SRC/dorbdb2.f‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -289,8 +289,8 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA,
289289
C = X11(I,I)
290290
CALL DLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
291291
$ X11(I+1,I), LDX11, WORK(ILARF) )
292-
CALL DLARF1F( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
293-
$ X21(I,I), LDX21, WORK(ILARF) )
292+
CALL DLARF1F( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11,
293+
$ TAUQ1(I), X21(I,I), LDX21, WORK(ILARF) )
294294
S = SQRT( DNRM2( P-I, X11(I+1,I), 1 )**2
295295
$ + DNRM2( M-P-I+1, X21(I,I), 1 )**2 )
296296
THETA(I) = ATAN2( S, C )

‎SRC/dorbdb4.f‎

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -308,10 +308,9 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA,
308308
C = COS( THETA(I) )
309309
S = SIN( THETA(I) )
310310
CALL DLARF1F( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11,
311-
$ LDX11,
312-
$ WORK(ILARF) )
313-
CALL DLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1), X21,
314-
$ LDX21, WORK(ILARF) )
311+
$ LDX11, WORK(ILARF) )
312+
CALL DLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1),
313+
$ X21, LDX21, WORK(ILARF) )
315314
ELSE
316315
CALL DORBDB5( P-I+1, M-P-I+1, Q-I+1, X11(I,I-1), 1,
317316
$ X21(I,I-1), 1, X11(I,I), LDX11, X21(I,I),
@@ -325,9 +324,9 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA,
325324
C = COS( THETA(I) )
326325
S = SIN( THETA(I) )
327326
CALL DLARF1F( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, TAUP1(I),
328-
$ X11(I,I), LDX11, WORK(ILARF) )
329-
CALL DLARF1F( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, TAUP2(I),
330-
$ X21(I,I), LDX21, WORK(ILARF) )
327+
$ X11(I,I), LDX11, WORK(ILARF) )
328+
CALL DLARF1F( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1,
329+
$ TAUP2(I), X21(I,I), LDX21, WORK(ILARF) )
331330
END IF
332331
*
333332
CALL DROT( Q-I+1, X11(I,I), LDX11, X21(I,I), LDX21, S, -C )

‎SRC/zlarf1f.f‎

Lines changed: 17 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -176,8 +176,6 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
176176
COMPLEX*16 ONE, ZERO
177177
PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
178178
$ ZERO = ( 0.0D+0, 0.0D+0 ) )
179-
INTEGER IONE
180-
PARAMETER ( IONE = 1 )
181179
* ..
182180
* .. Local Scalars ..
183181
LOGICAL APPLYLEFT
@@ -225,8 +223,8 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
225223
! Scan for the last non-zero row in C(:,1:lastv).
226224
LASTC = ILAZLR(M, LASTV, C, LDC)
227225
END IF
228-
ELSE
229-
! TAU is 0, so H = I. Meaning HC = C = CH.
226+
END IF
227+
IF( LASTC.EQ.0 ) THEN
230228
RETURN
231229
END IF
232230
IF( APPLYLEFT ) THEN
@@ -246,25 +244,29 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
246244
! C = [ C_1 C_2 ]**T, v = [1 v_2]**T
247245
! w = C_1**H + C_2**Hv_2
248246
! w = C_2**Hv_2
249-
CALL ZGEMV( 'Conj', LASTV-1, LASTC, ONE, C(1+1,1), LDC,
250-
$ V(1+INCV), INCV, ZERO, WORK, 1)
251-
! w += C_1**H
252-
! This is essentially a zaxpyc
253-
DO J = 1, LASTC
254-
WORK(J) = WORK(J) + DCONJG(C(1,J))
247+
CALL ZGEMV( 'Conjugate transpose', LASTV - 1,
248+
$ LASTC, ONE, C( 1+1, 1 ), LDC, V( 1 + INCV ),
249+
$ INCV, ZERO, WORK, 1 )
250+
*
251+
* w(1:lastc,1) += v(1,1) * C(1,1:lastc)**H
252+
*
253+
DO I = 1, LASTC
254+
WORK( I ) = WORK( I ) + DCONJG( C( 1, I ) )
255255
END DO
256256
*
257257
* C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**H
258258
*
259259
! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**H
260260
! = C(...) - tau * Conj(w(1:lastc,1))
261261
! This is essentially a zaxpyc
262-
DO J = 1, LASTC
263-
C(1,J) = C(1,J) - TAU * DCONJG(WORK(J))
262+
DO I = 1, LASTC
263+
C( 1, I ) = C( 1, I ) - TAU * DCONJG( WORK( I ) )
264264
END DO
265-
! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**H
266-
CALL ZGERC(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK,
267-
$ 1, C(1+1,1), LDC)
265+
*
266+
* C(2:lastv,1:lastc) += - tau * v(2:lastv,1) * w(1:lastc,1)**H
267+
*
268+
CALL ZGERC( LASTV - 1, LASTC, -TAU, V( 1 + INCV ),
269+
$ INCV, WORK, 1, C( 1+1, 1 ), LDC )
268270
END IF
269271
ELSE
270272
*

0 commit comments

Comments
 (0)