--- rpl/lapack/lapack/zuncsd2by1.f 2016/08/27 15:27:15 1.4 +++ rpl/lapack/lapack/zuncsd2by1.f 2023/08/07 08:39:43 1.10 @@ -2,8 +2,8 @@ * * =========== DOCUMENTATION =========== * -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * *> \htmlonly *> Download ZUNCSD2BY1 + dependencies @@ -22,7 +22,7 @@ * X21, LDX21, THETA, U1, LDU1, U2, LDU2, V1T, * LDV1T, WORK, LWORK, RWORK, LRWORK, IWORK, * INFO ) -* +* * .. Scalar Arguments .. * CHARACTER JOBU1, JOBU2, JOBV1T * INTEGER INFO, LDU1, LDU2, LDV1T, LWORK, LDX11, LDX21, @@ -36,10 +36,10 @@ * $ X11(LDX11,*), X21(LDX21,*) * INTEGER IWORK(*) * .. -* -* +* +* *> \par Purpose: -*> ============= +* ============= *> *>\verbatim *> @@ -47,18 +47,19 @@ *> orthonormal columns that has been partitioned into a 2-by-1 block *> structure: *> -*> [ I 0 0 ] +*> [ I1 0 0 ] *> [ 0 C 0 ] *> [ X11 ] [ U1 | ] [ 0 0 0 ] *> X = [-----] = [---------] [----------] V1**T . *> [ X21 ] [ | U2 ] [ 0 0 0 ] *> [ 0 S 0 ] -*> [ 0 0 I ] -*> +*> [ 0 0 I2] +*> *> X11 is P-by-Q. The unitary matrices U1, U2, and V1 are P-by-P, *> (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R *> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which -*> R = MIN(P,M-P,Q,M-Q). +*> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a +*> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). *> \endverbatim * * Arguments: @@ -188,9 +189,10 @@ *> The dimension of the array WORK. *> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns -*> this value as the first entry of the work array, and no error -*> message related to LWORK is issued by XERBLA. +*> only calculates the optimal size of the WORK and RWORK +*> arrays, returns this value as the first entry of the WORK +*> and RWORK array, respectively, and no error message related +*> to LWORK or LRWORK is issued by XERBLA. *> \endverbatim *> *> \param[out] RWORK @@ -208,11 +210,12 @@ *> \verbatim *> LRWORK is INTEGER *> The dimension of the array RWORK. -*> -*> If LRWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the RWORK array, returns -*> this value as the first entry of the work array, and no error -*> message related to LRWORK is issued by XERBLA. +*> +*> If LRWORK=-1, then a workspace query is assumed; the routine +*> only calculates the optimal size of the WORK and RWORK +*> arrays, returns this value as the first entry of the WORK +*> and RWORK array, respectively, and no error message related +*> to LWORK or LRWORK is issued by XERBLA. *> \endverbatim * *> \param[out] IWORK @@ -238,12 +241,10 @@ * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date July 2012 +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \ingroup complex16OTHERcomputational * @@ -253,10 +254,9 @@ $ LDV1T, WORK, LWORK, RWORK, LRWORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.6.1) -- +* -- LAPACK computational routine -- * -- 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 @@ -271,7 +271,7 @@ $ X11(LDX11,*), X21(LDX21,*) INTEGER IWORK(*) * .. -* +* * ===================================================================== * * .. Parameters .. @@ -311,7 +311,7 @@ WANTU1 = LSAME( JOBU1, 'Y' ) WANTU2 = LSAME( JOBU2, 'Y' ) WANTV1T = LSAME( JOBV1T, 'Y' ) - LQUERY = LWORK .EQ. -1 + LQUERY = ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) * IF( M .LT. 0 ) THEN INFO = -4 @@ -510,6 +510,9 @@ IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN INFO = -19 END IF + IF( LRWORK .LT. LRWORKMIN .AND. .NOT.LQUERY ) THEN + INFO = -21 + END IF END IF IF( INFO .NE. 0 ) THEN CALL XERBLA( 'ZUNCSD2BY1', -INFO ) @@ -556,16 +559,16 @@ CALL ZUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQ, CHILDINFO ) END IF -* +* * Simultaneously diagonalize X11 and X21. -* +* CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, $ 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 ) -* + $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), + $ LRWORK-IBBCSD+1, CHILDINFO ) +* * Permute rows and columns to place zero submatrices in * preferred positions * @@ -610,16 +613,16 @@ CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQ, CHILDINFO ) END IF -* +* * Simultaneously diagonalize X11 and X21. -* +* CALL ZBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, $ 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 ) -* +* * Permute rows and columns to place identity submatrices in * preferred positions * @@ -665,16 +668,16 @@ CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQ, CHILDINFO ) END IF -* +* * Simultaneously diagonalize X11 and X21. -* +* CALL ZBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, $ 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), $ RWORK(IBBCSD), LBBCSD, CHILDINFO ) -* +* * Permute rows and columns to place identity submatrices in * preferred positions * @@ -705,6 +708,9 @@ * * Accumulate Householder reflectors * + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 ) + END IF IF( WANTU1 .AND. P .GT. 0 ) THEN CALL ZCOPY( P, WORK(IORBDB), 1, U1, 1 ) DO J = 2, P @@ -716,7 +722,6 @@ $ WORK(IORGQR), LORGQR, CHILDINFO ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN - CALL ZCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 ) DO J = 2, M-P U2(1,J) = ZERO END DO @@ -734,16 +739,16 @@ CALL ZUNGLQ( Q, Q, Q, V1T, LDV1T, WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQ, CHILDINFO ) END IF -* +* * Simultaneously diagonalize X11 and X21. -* +* CALL ZBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, $ 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 *