Merge pull request Reference-LAPACK#697 from weslleyspereira/fix-sorcsd

Fix sorcsd
chrwarm · Sep 18, 2022 · 4f5e185 · 4f5e185
2 parents 801ac2f + 2ba5e8e
commit 4f5e185
Show file tree

Hide file tree

Showing 9 changed files with 20 additions and 17 deletions.
diff --git a/SRC/cunbdb2.f b/SRC/cunbdb2.f
@@ -122,14 +122,14 @@
 *>
 *> \param[out] TAUP1
 *> \verbatim
-*>          TAUP1 is COMPLEX array, dimension (P)
+*>          TAUP1 is COMPLEX array, dimension (P-1)
 *>           The scalar factors of the elementary reflectors that define
 *>           P1.
 *> \endverbatim
 *>
 *> \param[out] TAUP2
 *> \verbatim
-*>          TAUP2 is COMPLEX array, dimension (M-P)
+*>          TAUP2 is COMPLEX array, dimension (Q)
 *>           The scalar factors of the elementary reflectors that define
 *>           P2.
 *> \endverbatim

diff --git a/SRC/cunbdb4.f b/SRC/cunbdb4.f
@@ -124,14 +124,14 @@
 *>
 *> \param[out] TAUP1
 *> \verbatim
-*>          TAUP1 is COMPLEX array, dimension (P)
+*>          TAUP1 is COMPLEX array, dimension (M-Q)
 *>           The scalar factors of the elementary reflectors that define
 *>           P1.
 *> \endverbatim
 *>
 *> \param[out] TAUP2
 *> \verbatim
-*>          TAUP2 is COMPLEX array, dimension (M-P)
+*>          TAUP2 is COMPLEX array, dimension (M-Q)
 *>           The scalar factors of the elementary reflectors that define
 *>           P2.
 *> \endverbatim

diff --git a/SRC/dorbdb2.f b/SRC/dorbdb2.f
@@ -122,14 +122,14 @@
 *>
 *> \param[out] TAUP1
 *> \verbatim
-*>          TAUP1 is DOUBLE PRECISION array, dimension (P)
+*>          TAUP1 is DOUBLE PRECISION array, dimension (P-1)
 *>           The scalar factors of the elementary reflectors that define
 *>           P1.
 *> \endverbatim
 *>
 *> \param[out] TAUP2
 *> \verbatim
-*>          TAUP2 is DOUBLE PRECISION array, dimension (M-P)
+*>          TAUP2 is DOUBLE PRECISION array, dimension (Q)
 *>           The scalar factors of the elementary reflectors that define
 *>           P2.
 *> \endverbatim

diff --git a/SRC/dorbdb4.f b/SRC/dorbdb4.f
@@ -124,14 +124,14 @@
 *>
 *> \param[out] TAUP1
 *> \verbatim
-*>          TAUP1 is DOUBLE PRECISION array, dimension (P)
+*>          TAUP1 is DOUBLE PRECISION array, dimension (M-Q)
 *>           The scalar factors of the elementary reflectors that define
 *>           P1.
 *> \endverbatim
 *>
 *> \param[out] TAUP2
 *> \verbatim
-*>          TAUP2 is DOUBLE PRECISION array, dimension (M-P)
+*>          TAUP2 is DOUBLE PRECISION array, dimension (M-Q)
 *>           The scalar factors of the elementary reflectors that define
 *>           P2.
 *> \endverbatim

diff --git a/SRC/dorcsd2by1.f b/SRC/dorcsd2by1.f
@@ -580,7 +580,7 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
 *        Simultaneously diagonalize X11 and X21.
 *
          CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA,
-     $                WORK(IPHI), V1T, LDV1T, DUM2, 1, U1, LDU1, U2,
+     $                WORK(IPHI), V1T, LDV1T, DUM1, 1, U1, LDU1, U2,
      $                LDU2, WORK(IB11D), WORK(IB11E), WORK(IB12D),
      $                WORK(IB12E), WORK(IB21D), WORK(IB21E),
      $                WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD,
@@ -635,7 +635,7 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
 *        Simultaneously diagonalize X11 and X21.
 *
          CALL DBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P,
-     $                THETA, WORK(IPHI), DUM2, 1, V1T, LDV1T, U2,
+     $                THETA, WORK(IPHI), DUM1, 1, V1T, LDV1T, U2,
      $                LDU2, U1, LDU1, WORK(IB11D), WORK(IB11E),
      $                WORK(IB12D), WORK(IB12E), WORK(IB21D),
      $                WORK(IB21E), WORK(IB22D), WORK(IB22E),
@@ -706,7 +706,7 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
 *        Simultaneously diagonalize X11 and X21.
 *
          CALL DBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q,
-     $                THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM2,
+     $                THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM1,
      $                1, V1T, LDV1T, WORK(IB11D), WORK(IB11E),
      $                WORK(IB12D), WORK(IB12E), WORK(IB21D),
      $                WORK(IB21E), WORK(IB22D), WORK(IB22E),

diff --git a/SRC/sorbdb4.f b/SRC/sorbdb4.f
@@ -124,7 +124,7 @@
 *>
 *> \param[out] TAUP1
 *> \verbatim
-*>          TAUP1 is REAL array, dimension (P)
+*>          TAUP1 is REAL array, dimension (M-Q)
 *>           The scalar factors of the elementary reflectors that define
 *>           P1.
 *> \endverbatim

diff --git a/SRC/sorcsd2by1.f b/SRC/sorcsd2by1.f
@@ -672,10 +672,13 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
 *        Accumulate Householder reflectors
 *
          IF( WANTU2 .AND. M-P .GT. 0 ) THEN
-            CALL SCOPY( M-Q, WORK(IORBDB+P), 1, U2, 1 )
+            CALL SCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
          END IF
          IF( WANTU1 .AND. P .GT. 0 ) THEN
             CALL SCOPY( P, WORK(IORBDB), 1, U1, 1 )
+            DO J = 2, P
+               U1(1,J) = ZERO
+            END DO
             CALL SLACPY( 'L', P-1, M-Q-1, X11(2,1), LDX11, U1(2,2),
      $                   LDU1 )
             CALL SORGQR( P, P, M-Q, U1, LDU1, WORK(ITAUP1),

diff --git a/SRC/zunbdb2.f b/SRC/zunbdb2.f
@@ -122,14 +122,14 @@
 *>
 *> \param[out] TAUP1
 *> \verbatim
-*>          TAUP1 is COMPLEX*16 array, dimension (P)
+*>          TAUP1 is COMPLEX*16 array, dimension (P-1)
 *>           The scalar factors of the elementary reflectors that define
 *>           P1.
 *> \endverbatim
 *>
 *> \param[out] TAUP2
 *> \verbatim
-*>          TAUP2 is COMPLEX*16 array, dimension (M-P)
+*>          TAUP2 is COMPLEX*16 array, dimension (Q)
 *>           The scalar factors of the elementary reflectors that define
 *>           P2.
 *> \endverbatim

diff --git a/SRC/zunbdb4.f b/SRC/zunbdb4.f
@@ -124,14 +124,14 @@
 *>
 *> \param[out] TAUP1
 *> \verbatim
-*>          TAUP1 is COMPLEX*16 array, dimension (P)
+*>          TAUP1 is COMPLEX*16 array, dimension (M-Q)
 *>           The scalar factors of the elementary reflectors that define
 *>           P1.
 *> \endverbatim
 *>
 *> \param[out] TAUP2
 *> \verbatim
-*>          TAUP2 is COMPLEX*16 array, dimension (M-P)
+*>          TAUP2 is COMPLEX*16 array, dimension (M-Q)
 *>           The scalar factors of the elementary reflectors that define
 *>           P2.
 *> \endverbatim