fixing compilation errors in test suite

Reference-LAPACK · Jun 20, 2024 · 9a51a35 · 9a51a35
1 parent 57b267c
commit 9a51a35
Show file tree

Hide file tree

Showing 5 changed files with 41 additions and 41 deletions.
diff --git a/SRC/dorbdb.f b/SRC/dorbdb.f
@@ -440,13 +440,12 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12,
      $                     X12(I,I), LDX12, WORK )
             END IF
             IF ( Q .GT. I ) THEN
-               CALL DLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
-     $                     X21(I,I+1), LDX21, WORK )
+               CALL DLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1,
+     $                       TAUP2(I), X21(I,I+1), LDX21, WORK )
             END IF
             IF ( M-Q+1 .GT. I ) THEN
                CALL DLARF1F( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1,
-     $                     TAUP2(I),
-     $                     X22(I,I), LDX22, WORK )
+     $                       TAUP2(I), X22(I,I), LDX22, WORK )
             END IF
 *
             IF( I .LT. Q ) THEN
@@ -638,15 +637,14 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12,
             IF( I .LT. Q ) THEN
                CALL DLARF1F( 'L', Q-I, P-I, X11(I+1,I), 1, TAUQ1(I),
      $                     X11(I+1,I+1), LDX11, WORK )
-               CALL DLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1, TAUQ1(I),
-     $                     X21(I+1,I+1), LDX21, WORK )
+               CALL DLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1,
+     $                       TAUQ1(I), X21(I+1,I+1), LDX21, WORK )
             END IF
             CALL DLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),
-     $                  X12(I,I+1), LDX12, WORK )
+     $                    X12(I,I+1), LDX12, WORK )
             IF ( M-P-I .GT. 0 ) THEN
                CALL DLARF1F( 'L', M-Q-I+1, M-P-I, X12(I,I), 1,
-     $                     TAUQ2(I),
-     $                     X22(I,I+1), LDX22, WORK )
+     $                       TAUQ2(I), X22(I,I+1), LDX22, WORK )
             END IF
 *
          END DO
@@ -660,13 +658,12 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12,
      $                    TAUQ2(I) )
 *
             IF ( P .GT. I ) THEN
-               CALL DLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),
-     $                  X12(I,I+1), LDX12, WORK )
+               CALL DLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1,
+     $                       TAUQ2(I), X12(I,I+1), LDX12, WORK )
             END IF
             IF( M-P-Q .GE. 1 )
      $         CALL DLARF1F( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1,
-     $                     TAUQ2(I),
-     $                     X22(I,Q+1), LDX22, WORK )
+     $                       TAUQ2(I), X22(I,Q+1), LDX22, WORK )
 *
          END DO
 *
@@ -683,8 +680,9 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12,
                CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I),
      $                       1,
      $                       TAUQ2(P+I) )
-               CALL DLARF1F( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1,
-     $                  TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, WORK )
+               CALL DLARF1F( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I),
+     $                       1, TAUQ2(P+I), X22(P+I,Q+I+1), LDX22,
+     $                       WORK )
             END IF
 *
          END DO

diff --git a/SRC/dorbdb1.f b/SRC/dorbdb1.f
@@ -301,8 +301,9 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA,
             S = X21(I,I+1)
             CALL DLARF1F( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I),
      $                  X11(I+1,I+1), LDX11, WORK(ILARF) )
-            CALL DLARF1F( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I),
-     $                  X21(I+1,I+1), LDX21, WORK(ILARF) )
+            CALL DLARF1F( 'R', M-P-I, Q-I, X21(I,I+1), LDX21,
+     $                    TAUQ1(I), X21(I+1,I+1), LDX21,
+     $                    WORK(ILARF) )
             C = SQRT( DNRM2( P-I, X11(I+1,I+1), 1 )**2
      $          + DNRM2( M-P-I, X21(I+1,I+1), 1 )**2 )
             PHI(I) = ATAN2( S, C )

diff --git a/SRC/dorbdb2.f b/SRC/dorbdb2.f
@@ -289,8 +289,8 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA,
          C = X11(I,I)
          CALL DLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
      $               X11(I+1,I), LDX11, WORK(ILARF) )
-         CALL DLARF1F( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
-     $               X21(I,I), LDX21, WORK(ILARF) )
+         CALL DLARF1F( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11,
+     $                 TAUQ1(I), X21(I,I), LDX21, WORK(ILARF) )
          S = SQRT( DNRM2( P-I, X11(I+1,I), 1 )**2
      $           + DNRM2( M-P-I+1, X21(I,I), 1 )**2 )
          THETA(I) = ATAN2( S, C )

diff --git a/SRC/dorbdb4.f b/SRC/dorbdb4.f
@@ -308,10 +308,9 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA,
             C = COS( THETA(I) )
             S = SIN( THETA(I) )
             CALL DLARF1F( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11,
-     $                  LDX11,
-     $                  WORK(ILARF) )
-            CALL DLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1), X21,
-     $                  LDX21, WORK(ILARF) )
+     $                    LDX11, WORK(ILARF) )
+            CALL DLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1),
+     $                    X21, LDX21, WORK(ILARF) )
          ELSE
             CALL DORBDB5( P-I+1, M-P-I+1, Q-I+1, X11(I,I-1), 1,
      $                    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,
             C = COS( THETA(I) )
             S = SIN( THETA(I) )
             CALL DLARF1F( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, TAUP1(I),
-     $                  X11(I,I), LDX11, WORK(ILARF) )
-            CALL DLARF1F( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, TAUP2(I),
-     $                  X21(I,I), LDX21, WORK(ILARF) )
+     $                    X11(I,I), LDX11, WORK(ILARF) )
+            CALL DLARF1F( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1,
+     $                    TAUP2(I), X21(I,I), LDX21, WORK(ILARF) )
          END IF
 *
          CALL DROT( Q-I+1, X11(I,I), LDX11, X21(I,I), LDX21, S, -C )

diff --git a/SRC/zlarf1f.f b/SRC/zlarf1f.f
@@ -176,8 +176,6 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
       COMPLEX*16         ONE, ZERO
       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
      $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
-      INTEGER            IONE
-      PARAMETER          ( IONE = 1 )
 *     ..
 *     .. Local Scalars ..
       LOGICAL            APPLYLEFT
@@ -225,8 +223,8 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
 !     Scan for the last non-zero row in C(:,1:lastv).
             LASTC = ILAZLR(M, LASTV, C, LDC)
          END IF
-      ELSE
-!        TAU is 0, so H = I. Meaning HC = C = CH.
+      END IF
+      IF( LASTC.EQ.0 ) THEN
          RETURN
       END IF
       IF( APPLYLEFT ) THEN
@@ -246,25 +244,29 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
                ! C = [ C_1 C_2 ]**T, v = [1 v_2]**T
                ! w = C_1**H + C_2**Hv_2
                ! w = C_2**Hv_2
-               CALL ZGEMV( 'Conj', LASTV-1, LASTC, ONE, C(1+1,1), LDC,
-     $                     V(1+INCV), INCV, ZERO, WORK, 1)
-               ! w += C_1**H
-               ! This is essentially a zaxpyc
-               DO J = 1, LASTC
-                  WORK(J) = WORK(J) + DCONJG(C(1,J))
+               CALL ZGEMV( 'Conjugate transpose', LASTV - 1,
+     $               LASTC, ONE, C( 1+1, 1 ), LDC, V( 1 + INCV ),
+     $               INCV, ZERO, WORK, 1 )
+*
+*              w(1:lastc,1) += v(1,1) * C(1,1:lastc)**H
+*
+               DO I = 1, LASTC
+                  WORK( I ) = WORK( I ) + DCONJG( C( 1, I ) )
                END DO
 *
 *           C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**H
 *
             ! C(1, 1:lastc)   := C(...) - tau * v(1,1) * w(1:lastc,1)**H
             !                  = C(...) - tau * Conj(w(1:lastc,1))
             ! This is essentially a zaxpyc
-               DO J = 1, LASTC
-                  C(1,J) = C(1,J) - TAU * DCONJG(WORK(J))
+               DO I = 1, LASTC
+                  C( 1, I ) = C( 1, I ) - TAU * DCONJG( WORK( I ) )
                END DO
-               ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**H
-               CALL ZGERC(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK,
-     $                     1, C(1+1,1), LDC)
+*
+*        C(2:lastv,1:lastc) += - tau * v(2:lastv,1) * w(1:lastc,1)**H
+*
+               CALL ZGERC( LASTV - 1, LASTC, -TAU, V( 1 + INCV ),
+     $               INCV, WORK, 1, C( 1+1, 1 ), LDC )
             END IF
       ELSE
 *