Skip to content

Commit fe3cdc4

Browse files
xORCSD2BY1, xUNCSD2BY1: fix U2 orthogonality
The xORCSD2BY1/xUNCSD2BY1 output matrix U2 was clearly not orthogonal/unitary for certain input matrix dimensions m, p, and q (e.g., m = 260, p=130, q=131). The reason was an accidental overwrite of data by xORGQR()/xUNGQR() when the WORK array was apparently large enough to use blocking.
1 parent eb1921a commit fe3cdc4

File tree

4 files changed

+13
-4
lines changed

4 files changed

+13
-4
lines changed

SRC/cuncsd2by1.f

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -711,6 +711,10 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
711711
*
712712
* Accumulate Householder reflectors
713713
*
714+
715+
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
716+
CALL CCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
717+
END IF
714718
IF( WANTU1 .AND. P .GT. 0 ) THEN
715719
CALL CCOPY( P, WORK(IORBDB), 1, U1, 1 )
716720
DO J = 2, P
@@ -722,7 +726,6 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
722726
$ WORK(IORGQR), LORGQR, CHILDINFO )
723727
END IF
724728
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
725-
CALL CCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
726729
DO J = 2, M-P
727730
U2(1,J) = ZERO
728731
END DO

SRC/dorcsd2by1.f

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -674,6 +674,9 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
674674
*
675675
* Accumulate Householder reflectors
676676
*
677+
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
678+
CALL DCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
679+
END IF
677680
IF( WANTU1 .AND. P .GT. 0 ) THEN
678681
CALL DCOPY( P, WORK(IORBDB), 1, U1, 1 )
679682
DO J = 2, P
@@ -685,7 +688,6 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
685688
$ WORK(IORGQR), LORGQR, CHILDINFO )
686689
END IF
687690
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
688-
CALL DCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
689691
DO J = 2, M-P
690692
U2(1,J) = ZERO
691693
END DO

SRC/sorcsd2by1.f

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -674,6 +674,9 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
674674
*
675675
* Accumulate Householder reflectors
676676
*
677+
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
678+
CALL SCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
679+
END IF
677680
IF( WANTU1 .AND. P .GT. 0 ) THEN
678681
CALL SCOPY( P, WORK(IORBDB), 1, U1, 1 )
679682
DO J = 2, P
@@ -685,7 +688,6 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
685688
$ WORK(IORGQR), LORGQR, CHILDINFO )
686689
END IF
687690
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
688-
CALL SCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
689691
DO J = 2, M-P
690692
U2(1,J) = ZERO
691693
END DO

SRC/zuncsd2by1.f

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -709,6 +709,9 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
709709
*
710710
* Accumulate Householder reflectors
711711
*
712+
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
713+
CALL ZCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
714+
END IF
712715
IF( WANTU1 .AND. P .GT. 0 ) THEN
713716
CALL ZCOPY( P, WORK(IORBDB), 1, U1, 1 )
714717
DO J = 2, P
@@ -720,7 +723,6 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
720723
$ WORK(IORGQR), LORGQR, CHILDINFO )
721724
END IF
722725
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
723-
CALL ZCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
724726
DO J = 2, M-P
725727
U2(1,J) = ZERO
726728
END DO

0 commit comments

Comments
 (0)