--- rpl/lapack/lapack/zuncsd2by1.f 2015/11/26 11:44:27 1.3 +++ rpl/lapack/lapack/zuncsd2by1.f 2016/08/27 15:27:15 1.4 @@ -253,7 +253,7 @@ $ LDV1T, WORK, LWORK, RWORK, LRWORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -287,6 +287,10 @@ $ LWORKMIN, LWORKOPT, R LOGICAL LQUERY, WANTU1, WANTU2, WANTV1T * .. +* .. Local Arrays .. + DOUBLE PRECISION DUM( 1 ) + COMPLEX*16 CDUM( 1, 1 ) +* .. * .. External Subroutines .. EXTERNAL ZBBCSD, ZCOPY, ZLACPY, ZLAPMR, ZLAPMT, ZUNBDB1, $ ZUNBDB2, ZUNBDB3, ZUNBDB4, ZUNGLQ, ZUNGQR, @@ -319,11 +323,11 @@ INFO = -8 ELSE IF( LDX21 .LT. MAX( 1, M-P ) ) THEN INFO = -10 - ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN + ELSE IF( WANTU1 .AND. LDU1 .LT. MAX( 1, P ) ) THEN INFO = -13 - ELSE IF( WANTU2 .AND. LDU2 .LT. M - P ) THEN + ELSE IF( WANTU2 .AND. LDU2 .LT. MAX( 1, M - P ) ) THEN INFO = -15 - ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN + ELSE IF( WANTV1T .AND. LDV1T .LT. MAX( 1, Q ) ) THEN INFO = -17 END IF * @@ -379,99 +383,118 @@ IORBDB = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ1 + MAX( 1, Q ) IORGLQ = ITAUQ1 + MAX( 1, Q ) + LORGQRMIN = 1 + LORGQROPT = 1 + LORGLQMIN = 1 + LORGLQOPT = 1 IF( R .EQ. Q ) THEN - CALL ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK, -1, CHILDINFO ) + CALL ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK, -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL ZUNGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P, P, Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + ENDIF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q-1, Q-1, Q-1, V1T, LDV1T, + $ CDUM, WORK(1), -1, CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q-1 ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( MAX(0,Q-1), MAX(0,Q-1), MAX(0,Q-1), V1T, LDV1T, - $ 0, WORK(1), -1, CHILDINFO ) - LORGLQMIN = MAX( 1, Q-1 ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ 0, U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, 0, 0, - $ 0, 0, 0, 0, 0, 0, RWORK(1), -1, CHILDINFO ) + $ DUM, U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM, 1, + $ DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE IF( R .EQ. P ) THEN - CALL ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P-1 .GE. M-P ) THEN - CALL ZUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, 0, WORK(1), + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, CDUM, WORK(1), $ -1, CHILDINFO ) - LORGQRMIN = MAX( 1, P-1 ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ 0, V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, 0, 0, - $ 0, 0, 0, 0, 0, 0, RWORK(1), -1, CHILDINFO ) + $ DUM, V1T, LDV1T, CDUM, 1, U1, LDU1, U2, LDU2, + $ DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE IF( R .EQ. M-P ) THEN - CALL ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P-1 ) THEN - CALL ZUNGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P, P, Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, 0, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, CDUM, $ WORK(1), -1, CHILDINFO ) - LORGQRMIN = MAX( 1, M-P-1 ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, 0, 0, 1, V1T, LDV1T, U2, LDU2, U1, LDU1, - $ 0, 0, 0, 0, 0, 0, 0, 0, RWORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM, CDUM, 1, V1T, LDV1T, U2, LDU2, U1, + $ LDU1, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE - CALL ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, 0, WORK(1), -1, CHILDINFO ) + CALL ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO + $ ) LORBDB = M + INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL ZUNGQR( P, P, M-Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P, P, M-Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P, M-P, M-Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P, M-P, M-Q, U2, LDU2, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q, Q, Q, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( Q, Q, Q, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, 0, U2, LDU2, U1, LDU1, 0, 1, V1T, LDV1T, - $ 0, 0, 0, 0, 0, 0, 0, 0, RWORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM, U2, LDU2, U1, LDU1, CDUM, 1, V1T, + $ LDV1T, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) END IF LRWORKMIN = IBBCSD+LBBCSD-1 @@ -537,8 +560,8 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, - $ RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), + $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM, + $ 1, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -591,8 +614,8 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ RWORK(IPHI), V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, - $ RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), + $ RWORK(IPHI), V1T, LDV1T, CDUM, 1, U1, LDU1, U2, + $ LDU2, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -646,7 +669,7 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, RWORK(IPHI), 0, 1, V1T, LDV1T, U2, LDU2, + $ THETA, RWORK(IPHI), CDUM, 1, V1T, LDV1T, U2, LDU2, $ U1, LDU1, RWORK(IB11D), RWORK(IB11E), $ RWORK(IB12D), RWORK(IB12E), RWORK(IB21D), $ RWORK(IB21E), RWORK(IB22D), RWORK(IB22E), @@ -715,11 +738,11 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, RWORK(IPHI), U2, LDU2, U1, LDU1, 0, 1, V1T, - $ LDV1T, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), - $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), - $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ THETA, RWORK(IPHI), U2, LDU2, U1, LDU1, CDUM, 1, + $ V1T, LDV1T, RWORK(IB11D), RWORK(IB11E), + $ RWORK(IB12D), RWORK(IB12E), RWORK(IB21D), + $ RWORK(IB21E), RWORK(IB22D), RWORK(IB22E), + $ RWORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place identity submatrices in * preferred positions