--- rpl/lapack/lapack/dorcsd2by1.f 2018/05/29 07:18:02 1.9 +++ rpl/lapack/lapack/dorcsd2by1.f 2023/08/07 08:39:01 1.10 @@ -224,8 +224,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date July 2012 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== @@ -236,7 +234,6 @@ * -- LAPACK computational routine (3.5.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* July 2012 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T @@ -583,7 +580,7 @@ * 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, @@ -638,7 +635,7 @@ * 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), @@ -674,6 +671,9 @@ * * Accumulate Householder reflectors * + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL DCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 ) + END IF IF( WANTU1 .AND. P .GT. 0 ) THEN CALL DCOPY( P, WORK(IORBDB), 1, U1, 1 ) DO J = 2, P @@ -685,7 +685,6 @@ $ WORK(IORGQR), LORGQR, CHILDINFO ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN - CALL DCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 ) DO J = 2, M-P U2(1,J) = ZERO END DO @@ -707,7 +706,7 @@ * 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),