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