diff --git a/lapack-netlib/SRC/cggsvd3.f b/lapack-netlib/SRC/cggsvd3.f index 4c4b85baee..cae00df676 100644 --- a/lapack-netlib/SRC/cggsvd3.f +++ b/lapack-netlib/SRC/cggsvd3.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download CGGSVD3 + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -351,6 +349,7 @@ SUBROUTINE CGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, $ WORK, LWORK, RWORK, IWORK, INFO ) + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -422,13 +421,14 @@ SUBROUTINE CGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN INFO = -20 ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN - INFO = -24 + INFO = -22 END IF * * Compute workspace * IF( INFO.EQ.0 ) THEN - CALL CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, + CALL CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, + $ TOLA, $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, RWORK, $ WORK, WORK, -1, INFO ) LWKOPT = N + INT( WORK( 1 ) ) @@ -455,8 +455,8 @@ SUBROUTINE CGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, * ULP = SLAMCH( 'Precision' ) UNFL = SLAMCH( 'Safe Minimum' ) - TOLA = MAX( M, N )*MAX( ANORM, UNFL )*ULP - TOLB = MAX( P, N )*MAX( BNORM, UNFL )*ULP + TOLA = REAL( MAX( M, N ) )*MAX( ANORM, UNFL )*ULP + TOLB = REAL( MAX( P, N ) )*MAX( BNORM, UNFL )*ULP * CALL CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, RWORK, diff --git a/lapack-netlib/SRC/claqz0.f b/lapack-netlib/SRC/claqz0.f index c6cc5847d7..3433b4c8a5 100644 --- a/lapack-netlib/SRC/claqz0.f +++ b/lapack-netlib/SRC/claqz0.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download CLAQZ0 + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -274,10 +272,11 @@ * *> \date May 2020 * -*> \ingroup complexGEcomputational +*> \ingroup laqz0 *> * ===================================================================== - RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, + RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, + $ A, $ LDA, B, LDB, ALPHA, BETA, Q, LDQ, Z, $ LDZ, WORK, LWORK, RWORK, REC, $ INFO ) @@ -412,12 +411,14 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, NSR = MAX( 2, NSR-MOD( NSR, 2 ) ) RCOST = ILAENV( 17, 'CLAQZ0', JBCMPZ, N, ILO, IHI, LWORK ) - ITEMP1 = INT( NSR/SQRT( 1+2*NSR/( REAL( RCOST )/100*N ) ) ) + ITEMP1 = INT( REAL( NSR )/SQRT( 1+2*REAL( NSR )/ + $ ( REAL( RCOST )/100*REAL( N ) ) ) ) ITEMP1 = ( ( ITEMP1-1 )/4 )*4+4 NBR = NSR+ITEMP1 IF( N .LT. NMIN .OR. REC .GE. 2 ) THEN - CALL CHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, LDB, + CALL CHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, + $ LDB, $ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, $ INFO ) RETURN @@ -429,7 +430,8 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Workspace query to CLAQZ2 NW = MAX( NWR, NMIN ) - CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB, + CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, + $ LDB, $ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHA, $ BETA, WORK, NW, WORK, NW, WORK, -1, RWORK, REC, $ AED_INFO ) @@ -445,10 +447,10 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, WORK( 1 ) = REAL( LWORKREQ ) RETURN ELSE IF ( LWORK .LT. LWORKREQ ) THEN - INFO = -19 + INFO = -18 END IF IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CLAQZ0', INFO ) + CALL XERBLA( 'CLAQZ0', -INFO ) RETURN END IF * @@ -536,17 +538,20 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * to the top and deflate it DO K2 = K, ISTART2+1, -1 - CALL CLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1, + CALL CLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, + $ S1, $ TEMP ) B( K2-1, K2 ) = TEMP B( K2-1, K2-1 ) = CZERO CALL CROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1, $ B( ISTARTM, K2-1 ), 1, C1, S1 ) - CALL CROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM, + CALL CROT( MIN( K2+1, ISTOP )-ISTARTM+1, + $ A( ISTARTM, $ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 ) IF ( ILZ ) THEN - CALL CROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1, + CALL CROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, + $ C1, $ S1 ) END IF @@ -556,9 +561,11 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, A( K2, K2-1 ) = TEMP A( K2+1, K2-1 ) = CZERO - CALL CROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1, + CALL CROT( ISTOPM-K2+1, A( K2, K2 ), LDA, + $ A( K2+1, $ K2 ), LDA, C1, S1 ) - CALL CROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1, + CALL CROT( ISTOPM-K2+1, B( K2, K2 ), LDB, + $ B( K2+1, $ K2 ), LDB, C1, S1 ) IF( ILQ ) THEN CALL CROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1, @@ -620,7 +627,8 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for AED * - CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA, + CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, + $ LDA, $ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, $ ALPHA, BETA, WORK, NW, WORK( NW**2+1 ), NW, $ WORK( 2*NW**2+1 ), LWORK-2*NW**2, RWORK, REC, @@ -663,7 +671,8 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for a QZ sweep * - CALL CLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK, + CALL CLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, + $ NBLOCK, $ ALPHA( SHIFTPOS ), BETA( SHIFTPOS ), A, LDA, B, $ LDB, Q, LDQ, Z, LDZ, WORK, NBLOCK, WORK( NBLOCK** $ 2+1 ), NBLOCK, WORK( 2*NBLOCK**2+1 ), diff --git a/lapack-netlib/SRC/claqz2.f b/lapack-netlib/SRC/claqz2.f index 895e0095bf..498aa74e42 100644 --- a/lapack-netlib/SRC/claqz2.f +++ b/lapack-netlib/SRC/claqz2.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download CLAQZ2 + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -209,6 +207,7 @@ *> REC is INTEGER *> REC indicates the current recursion level. Should be set *> to 0 on first call. +*> \endverbatim *> *> \param[out] INFO *> \verbatim @@ -224,10 +223,11 @@ * *> \date May 2020 * -*> \ingroup complexGEcomputational +*> \ingroup laqz2 *> * ===================================================================== - RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, + RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, + $ NW, $ A, LDA, B, LDB, Q, LDQ, Z, LDZ, NS, $ ND, ALPHA, BETA, QC, LDQC, ZC, LDZC, $ WORK, LWORK, RWORK, REC, INFO ) @@ -257,7 +257,7 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, COMPLEX :: S, S1, TEMP * External Functions - EXTERNAL :: XERBLA, CLAQZ0, CLAQZ1, SLABAD, CLACPY, CLASET, CGEMM, + EXTERNAL :: XERBLA, CLAQZ0, CLAQZ1, CLACPY, CLASET, CGEMM, $ CTGEXC, CLARTG, CROT REAL, EXTERNAL :: SLAMCH @@ -282,10 +282,10 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, LWORKREQ = MAX( LWORKREQ, N*NW, 2*NW**2+N ) IF ( LWORK .EQ.-1 ) THEN * workspace query, quick return - WORK( 1 ) = LWORKREQ + WORK( 1 ) = CMPLX( LWORKREQ ) RETURN ELSE IF ( LWORK .LT. LWORKREQ ) THEN - INFO = -26 + INFO = -25 END IF IF( INFO.NE.0 ) THEN @@ -296,7 +296,6 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Get machine constants SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( N )/ULP ) @@ -319,7 +318,8 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Store window in case of convergence failure CALL CLACPY( 'ALL', JW, JW, A( KWTOP, KWTOP ), LDA, WORK, JW ) - CALL CLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, WORK( JW**2+ + CALL CLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, + $ WORK( JW**2+ $ 1 ), JW ) * Transform window to real schur form @@ -334,7 +334,8 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Convergence failure, restore the window and exit ND = 0 NS = JW-QZ_SMALL_INFO - CALL CLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), LDA ) + CALL CLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), + $ LDA ) CALL CLACPY( 'ALL', JW, JW, WORK( JW**2+1 ), JW, B( KWTOP, $ KWTOP ), LDB ) RETURN @@ -391,11 +392,14 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A( K, KWTOP-1 ) = TEMP A( K+1, KWTOP-1 ) = CZERO K2 = MAX( KWTOP, K-1 ) - CALL CROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, C1, + CALL CROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, + $ C1, $ S1 ) - CALL CROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, K-1 ), + CALL CROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, + $ K-1 ), $ LDB, C1, S1 ) - CALL CROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, K+1-KWTOP+1 ), + CALL CROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, + $ K+1-KWTOP+1 ), $ 1, C1, CONJG( S1 ) ) END DO @@ -437,25 +441,29 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, $ IHI+1 ), LDB ) END IF IF ( ILQ ) THEN - CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Q( 1, KWTOP ), LDQ, QC, + CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Q( 1, KWTOP ), LDQ, + $ QC, $ LDQC, CZERO, WORK, N ) CALL CLACPY( 'ALL', N, JW, WORK, N, Q( 1, KWTOP ), LDQ ) END IF IF ( KWTOP-1-ISTARTM+1 > 0 ) THEN - CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, A( ISTARTM, + CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, + $ A( ISTARTM, $ KWTOP ), LDA, ZC, LDZC, CZERO, WORK, $ KWTOP-ISTARTM ) CALL CLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ A( ISTARTM, KWTOP ), LDA ) - CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, B( ISTARTM, + CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, + $ B( ISTARTM, $ KWTOP ), LDB, ZC, LDZC, CZERO, WORK, $ KWTOP-ISTARTM ) CALL CLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ B( ISTARTM, KWTOP ), LDB ) END IF IF ( ILZ ) THEN - CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Z( 1, KWTOP ), LDZ, ZC, + CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Z( 1, KWTOP ), LDZ, + $ ZC, $ LDZC, CZERO, WORK, N ) CALL CLACPY( 'ALL', N, JW, WORK, N, Z( 1, KWTOP ), LDZ ) END IF diff --git a/lapack-netlib/SRC/cunbdb4.f b/lapack-netlib/SRC/cunbdb4.f index 16e71860c1..0247c7c37c 100644 --- a/lapack-netlib/SRC/cunbdb4.f +++ b/lapack-netlib/SRC/cunbdb4.f @@ -280,7 +280,7 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, LWORKMIN = LWORKOPT WORK(1) = SROUNDUP_LWORK(LWORKOPT) IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN - INFO = -14 + INFO = -15 END IF END IF IF( INFO .NE. 0 ) THEN diff --git a/lapack-netlib/SRC/cuncsd.f b/lapack-netlib/SRC/cuncsd.f index 003daaab43..1fd12a120e 100644 --- a/lapack-netlib/SRC/cuncsd.f +++ b/lapack-netlib/SRC/cuncsd.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download CUNCSD + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -311,12 +309,14 @@ *> \ingroup uncsd * * ===================================================================== - RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, + RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, + $ TRANS, $ SIGNS, M, P, Q, X11, LDX11, X12, $ LDX12, X21, LDX21, X22, LDX22, THETA, $ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, WORK, LWORK, RWORK, LRWORK, $ IWORK, INFO ) + IMPLICIT NONE * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -360,7 +360,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, LOGICAL LRQUERY * .. * .. External Subroutines .. - EXTERNAL XERBLA, CBBCSD, CLACPY, CLAPMR, CLAPMT, + EXTERNAL XERBLA, CBBCSD, CLACPY, CLAPMR, + $ CLAPMT, $ CUNBDB, CUNGLQ, CUNGQR * .. * .. External Functions .. @@ -429,7 +430,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE SIGNST = 'D' END IF - CALL CUNCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, M, + CALL CUNCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, + $ M, $ Q, P, X11, LDX11, X21, LDX21, X12, LDX12, X22, $ LDX22, THETA, V1T, LDV1T, V2T, LDV2T, U1, LDU1, $ U2, LDU2, WORK, LWORK, RWORK, LRWORK, IWORK, @@ -477,7 +479,7 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, LBBCSDWORKMIN = LBBCSDWORKOPT LRWORKOPT = IBBCSD + LBBCSDWORKOPT - 1 LRWORKMIN = IBBCSD + LBBCSDWORKMIN - 1 - RWORK(1) = LRWORKOPT + RWORK(1) = REAL( LRWORKOPT ) * * Complex workspace * @@ -510,10 +512,10 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * IF( LWORK .LT. LWORKMIN $ .AND. .NOT. ( LQUERY .OR. LRQUERY ) ) THEN - INFO = -22 + INFO = -28 ELSE IF( LRWORK .LT. LRWORKMIN $ .AND. .NOT. ( LQUERY .OR. LRQUERY ) ) THEN - INFO = -24 + INFO = -30 ELSE LORGQRWORK = LWORK - IORGQR + 1 LORGLQWORK = LWORK - IORGLQ + 1 @@ -533,7 +535,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Transform to bidiagonal block form * - CALL CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21, + CALL CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + $ X21, $ LDX21, X22, LDX22, THETA, RWORK(IPHI), WORK(ITAUP1), $ WORK(ITAUP2), WORK(ITAUQ1), WORK(ITAUQ2), $ WORK(IORBDB), LORBDBWORK, CHILDINFO ) @@ -543,7 +546,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, IF( COLMAJOR ) THEN IF( WANTU1 .AND. P .GT. 0 ) THEN CALL CLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL CUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL CUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQRWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -559,7 +563,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL CUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL CUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -576,7 +581,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE IF( WANTU1 .AND. P .GT. 0 ) THEN CALL CLACPY( 'U', Q, P, X11, LDX11, U1, LDU1 ) - CALL CUNGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGLQ), + CALL CUNGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGLQ), $ LORGLQWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -592,7 +598,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL CUNGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL CUNGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGQR), LORGQRWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -610,7 +617,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Compute the CSD of the matrix in bidiagonal-block form * - CALL CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, THETA, + CALL CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + $ THETA, $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), diff --git a/lapack-netlib/SRC/dggsvd3.f b/lapack-netlib/SRC/dggsvd3.f index ee4d11e86f..ffd157f737 100644 --- a/lapack-netlib/SRC/dggsvd3.f +++ b/lapack-netlib/SRC/dggsvd3.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download DGGSVD3 + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -346,6 +344,7 @@ SUBROUTINE DGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, $ WORK, LWORK, IWORK, INFO ) + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -417,13 +416,14 @@ SUBROUTINE DGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN INFO = -20 ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN - INFO = -24 + INFO = -22 END IF * * Compute workspace * IF( INFO.EQ.0 ) THEN - CALL DGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, + CALL DGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, + $ TOLA, $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, WORK, $ WORK, -1, INFO ) LWKOPT = N + INT( WORK( 1 ) ) diff --git a/lapack-netlib/SRC/dorbdb4.f b/lapack-netlib/SRC/dorbdb4.f index 6a218fa8ad..36ad19a09e 100644 --- a/lapack-netlib/SRC/dorbdb4.f +++ b/lapack-netlib/SRC/dorbdb4.f @@ -278,7 +278,7 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, LWORKMIN = LWORKOPT WORK(1) = LWORKOPT IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN - INFO = -14 + INFO = -15 END IF END IF IF( INFO .NE. 0 ) THEN diff --git a/lapack-netlib/SRC/dorcsd.f b/lapack-netlib/SRC/dorcsd.f index 86463bd9b3..f0f77d7302 100644 --- a/lapack-netlib/SRC/dorcsd.f +++ b/lapack-netlib/SRC/dorcsd.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download DORCSD + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -289,14 +287,16 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup doubleOTHERcomputational +*> \ingroup uncsd * * ===================================================================== - RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, + RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, + $ TRANS, $ SIGNS, M, P, Q, X11, LDX11, X12, $ LDX12, X21, LDX21, X22, LDX22, THETA, $ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, WORK, LWORK, IWORK, INFO ) + IMPLICIT NONE * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -404,7 +404,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE SIGNST = 'D' END IF - CALL DORCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, M, + CALL DORCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, + $ M, $ Q, P, X11, LDX11, X21, LDX21, X12, LDX12, X22, $ LDX22, THETA, V1T, LDV1T, V2T, LDV2T, U1, LDU1, $ U2, LDU2, WORK, LWORK, IWORK, INFO ) @@ -474,7 +475,7 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, WORK(1) = MAX(LWORKOPT,LWORKMIN) * IF( LWORK .LT. LWORKMIN .AND. .NOT. LQUERY ) THEN - INFO = -22 + INFO = -28 ELSE LORGQRWORK = LWORK - IORGQR + 1 LORGLQWORK = LWORK - IORGLQ + 1 @@ -494,7 +495,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Transform to bidiagonal block form * - CALL DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21, + CALL DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + $ X21, $ LDX21, X22, LDX22, THETA, WORK(IPHI), WORK(ITAUP1), $ WORK(ITAUP2), WORK(ITAUQ1), WORK(ITAUQ2), $ WORK(IORBDB), LORBDBWORK, CHILDINFO ) @@ -504,7 +506,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, IF( COLMAJOR ) THEN IF( WANTU1 .AND. P .GT. 0 ) THEN CALL DLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL DORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL DORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQRWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -520,7 +523,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL DORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL DORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -537,7 +541,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE IF( WANTU1 .AND. P .GT. 0 ) THEN CALL DLACPY( 'U', Q, P, X11, LDX11, U1, LDU1 ) - CALL DORGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGLQ), + CALL DORGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGLQ), $ LORGLQWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -553,7 +558,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL DORGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL DORGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGQR), LORGQRWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -567,7 +573,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Compute the CSD of the matrix in bidiagonal-block form * - CALL DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, THETA, + CALL DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + $ THETA, $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), WORK(IB22D), diff --git a/lapack-netlib/SRC/sggsvd3.f b/lapack-netlib/SRC/sggsvd3.f index cee630593e..041a356f61 100644 --- a/lapack-netlib/SRC/sggsvd3.f +++ b/lapack-netlib/SRC/sggsvd3.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download SGGSVD3 + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -346,6 +344,7 @@ SUBROUTINE SGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, $ WORK, LWORK, IWORK, INFO ) + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -373,7 +372,8 @@ SUBROUTINE SGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, * .. External Functions .. LOGICAL LSAME REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SCOPY, SGGSVP3, STGSJA, XERBLA @@ -417,13 +417,14 @@ SUBROUTINE SGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN INFO = -20 ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN - INFO = -24 + INFO = -22 END IF * * Compute workspace * IF( INFO.EQ.0 ) THEN - CALL SGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, + CALL SGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, + $ TOLA, $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, WORK, $ WORK, -1, INFO ) LWKOPT = N + INT( WORK( 1 ) ) @@ -450,8 +451,8 @@ SUBROUTINE SGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, * ULP = SLAMCH( 'Precision' ) UNFL = SLAMCH( 'Safe Minimum' ) - TOLA = MAX( M, N )*MAX( ANORM, UNFL )*ULP - TOLB = MAX( P, N )*MAX( BNORM, UNFL )*ULP + TOLA = REAL( MAX( M, N ) )*MAX( ANORM, UNFL )*ULP + TOLB = REAL( MAX( P, N ) )*MAX( BNORM, UNFL )*ULP * * Preprocessing * diff --git a/lapack-netlib/SRC/sorbdb4.f b/lapack-netlib/SRC/sorbdb4.f index 4bd1affa45..42c79e9343 100644 --- a/lapack-netlib/SRC/sorbdb4.f +++ b/lapack-netlib/SRC/sorbdb4.f @@ -279,7 +279,7 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, LWORKMIN = LWORKOPT WORK(1) = REAL( LWORKOPT ) IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN - INFO = -14 + INFO = -15 END IF END IF IF( INFO .NE. 0 ) THEN diff --git a/lapack-netlib/SRC/sorcsd.f b/lapack-netlib/SRC/sorcsd.f index 30bee7a79f..2e386c2228 100644 --- a/lapack-netlib/SRC/sorcsd.f +++ b/lapack-netlib/SRC/sorcsd.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download SORCSD + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -289,14 +287,16 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup realOTHERcomputational +*> \ingroup uncsd * * ===================================================================== - RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, + RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, + $ TRANS, $ SIGNS, M, P, Q, X11, LDX11, X12, $ LDX12, X21, LDX21, X22, LDX22, THETA, $ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, WORK, LWORK, IWORK, INFO ) + IMPLICIT NONE * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -407,7 +407,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE SIGNST = 'D' END IF - CALL SORCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, M, + CALL SORCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, + $ M, $ Q, P, X11, LDX11, X21, LDX21, X12, LDX12, X22, $ LDX22, THETA, V1T, LDV1T, V2T, LDV2T, U1, LDU1, $ U2, LDU2, WORK, LWORK, IWORK, INFO ) @@ -440,12 +441,14 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ITAUQ1 = ITAUP2 + MAX( 1, M - P ) ITAUQ2 = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ2 + MAX( 1, M - Q ) - CALL SORGQR( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, -1, + CALL SORGQR( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, + $ -1, $ CHILDINFO ) LORGQRWORKOPT = INT( WORK(1) ) LORGQRWORKMIN = MAX( 1, M - Q ) IORGLQ = ITAUQ2 + MAX( 1, M - Q ) - CALL SORGLQ( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, -1, + CALL SORGLQ( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, + $ -1, $ CHILDINFO ) LORGLQWORKOPT = INT( WORK(1) ) LORGLQWORKMIN = MAX( 1, M - Q ) @@ -474,10 +477,10 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, $ IORBDB + LORBDBWORKOPT, IBBCSD + LBBCSDWORKOPT ) - 1 LWORKMIN = MAX( IORGQR + LORGQRWORKMIN, IORGLQ + LORGLQWORKMIN, $ IORBDB + LORBDBWORKOPT, IBBCSD + LBBCSDWORKMIN ) - 1 - WORK(1) = MAX(LWORKOPT,LWORKMIN) + WORK(1) = REAL( MAX(LWORKOPT,LWORKMIN) ) * IF( LWORK .LT. LWORKMIN .AND. .NOT. LQUERY ) THEN - INFO = -22 + INFO = -28 ELSE LORGQRWORK = LWORK - IORGQR + 1 LORGLQWORK = LWORK - IORGLQ + 1 @@ -497,7 +500,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Transform to bidiagonal block form * - CALL SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21, + CALL SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + $ X21, $ LDX21, X22, LDX22, THETA, WORK(IPHI), WORK(ITAUP1), $ WORK(ITAUP2), WORK(ITAUQ1), WORK(ITAUQ2), $ WORK(IORBDB), LORBDBWORK, CHILDINFO ) @@ -507,7 +511,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, IF( COLMAJOR ) THEN IF( WANTU1 .AND. P .GT. 0 ) THEN CALL SLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL SORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL SORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQRWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -523,7 +528,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL SORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL SORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -536,7 +542,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE IF( WANTU1 .AND. P .GT. 0 ) THEN CALL SLACPY( 'U', Q, P, X11, LDX11, U1, LDU1 ) - CALL SORGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGLQ), + CALL SORGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGLQ), $ LORGLQWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -552,7 +559,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL SORGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL SORGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGQR), LORGQRWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -566,7 +574,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Compute the CSD of the matrix in bidiagonal-block form * - CALL SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, THETA, + CALL SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + $ THETA, $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), WORK(IB22D), diff --git a/lapack-netlib/SRC/zggsvd3.f b/lapack-netlib/SRC/zggsvd3.f index 40624f5beb..4715471171 100644 --- a/lapack-netlib/SRC/zggsvd3.f +++ b/lapack-netlib/SRC/zggsvd3.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZGGSVD3 + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -350,6 +348,7 @@ SUBROUTINE ZGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, $ WORK, LWORK, RWORK, IWORK, INFO ) + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -421,13 +420,14 @@ SUBROUTINE ZGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN INFO = -20 ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN - INFO = -24 + INFO = -22 END IF * * Compute workspace * IF( INFO.EQ.0 ) THEN - CALL ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, + CALL ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, + $ TOLA, $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, RWORK, $ WORK, WORK, -1, INFO ) LWKOPT = N + INT( WORK( 1 ) ) diff --git a/lapack-netlib/SRC/zlaqz0.f b/lapack-netlib/SRC/zlaqz0.f index dcb28850a2..c5f58294dc 100644 --- a/lapack-netlib/SRC/zlaqz0.f +++ b/lapack-netlib/SRC/zlaqz0.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZLAQZ0 + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -274,10 +272,11 @@ * *> \date May 2020 * -*> \ingroup complex16GEcomputational +*> \ingroup laqz0 *> * ===================================================================== - RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, + RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, + $ A, $ LDA, B, LDB, ALPHA, BETA, Q, LDQ, Z, $ LDZ, WORK, LWORK, RWORK, REC, $ INFO ) @@ -419,7 +418,8 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, NBR = NSR+ITEMP1 IF( N .LT. NMIN .OR. REC .GE. 2 ) THEN - CALL ZHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, LDB, + CALL ZHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, + $ LDB, $ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, $ INFO ) RETURN @@ -431,7 +431,8 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Workspace query to ZLAQZ2 NW = MAX( NWR, NMIN ) - CALL ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB, + CALL ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, + $ LDB, $ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHA, $ BETA, WORK, NW, WORK, NW, WORK, -1, RWORK, REC, $ AED_INFO ) @@ -447,10 +448,10 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, WORK( 1 ) = DBLE( LWORKREQ ) RETURN ELSE IF ( LWORK .LT. LWORKREQ ) THEN - INFO = -19 + INFO = -18 END IF IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZLAQZ0', INFO ) + CALL XERBLA( 'ZLAQZ0', -INFO ) RETURN END IF * @@ -538,17 +539,20 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * to the top and deflate it DO K2 = K, ISTART2+1, -1 - CALL ZLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1, + CALL ZLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, + $ S1, $ TEMP ) B( K2-1, K2 ) = TEMP B( K2-1, K2-1 ) = CZERO CALL ZROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1, $ B( ISTARTM, K2-1 ), 1, C1, S1 ) - CALL ZROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM, + CALL ZROT( MIN( K2+1, ISTOP )-ISTARTM+1, + $ A( ISTARTM, $ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 ) IF ( ILZ ) THEN - CALL ZROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1, + CALL ZROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, + $ C1, $ S1 ) END IF @@ -558,9 +562,11 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, A( K2, K2-1 ) = TEMP A( K2+1, K2-1 ) = CZERO - CALL ZROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1, + CALL ZROT( ISTOPM-K2+1, A( K2, K2 ), LDA, + $ A( K2+1, $ K2 ), LDA, C1, S1 ) - CALL ZROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1, + CALL ZROT( ISTOPM-K2+1, B( K2, K2 ), LDB, + $ B( K2+1, $ K2 ), LDB, C1, S1 ) IF( ILQ ) THEN CALL ZROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1, @@ -622,7 +628,8 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for AED * - CALL ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA, + CALL ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, + $ LDA, $ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, $ ALPHA, BETA, WORK, NW, WORK( NW**2+1 ), NW, $ WORK( 2*NW**2+1 ), LWORK-2*NW**2, RWORK, REC, @@ -665,7 +672,8 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for a QZ sweep * - CALL ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK, + CALL ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, + $ NBLOCK, $ ALPHA( SHIFTPOS ), BETA( SHIFTPOS ), A, LDA, B, $ LDB, Q, LDQ, Z, LDZ, WORK, NBLOCK, WORK( NBLOCK** $ 2+1 ), NBLOCK, WORK( 2*NBLOCK**2+1 ), diff --git a/lapack-netlib/SRC/zlaqz2.f b/lapack-netlib/SRC/zlaqz2.f index 2e94e6dc49..640ab2f927 100644 --- a/lapack-netlib/SRC/zlaqz2.f +++ b/lapack-netlib/SRC/zlaqz2.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZLAQZ2 + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -224,10 +222,11 @@ * *> \date May 2020 * -*> \ingroup complex16GEcomputational +*> \ingroup laqz2 *> * ===================================================================== - RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, + RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, + $ NW, $ A, LDA, B, LDB, Q, LDQ, Z, LDZ, NS, $ ND, ALPHA, BETA, QC, LDQC, ZC, LDZC, $ WORK, LWORK, RWORK, REC, INFO ) @@ -258,7 +257,7 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, COMPLEX*16 :: S, S1, TEMP * External Functions - EXTERNAL :: XERBLA, ZLAQZ0, ZLAQZ1, DLABAD, ZLACPY, ZLASET, ZGEMM, + EXTERNAL :: XERBLA, ZLAQZ0, ZLAQZ1, ZLACPY, ZLASET, ZGEMM, $ ZTGEXC, ZLARTG, ZROT DOUBLE PRECISION, EXTERNAL :: DLAMCH @@ -286,7 +285,7 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, WORK( 1 ) = LWORKREQ RETURN ELSE IF ( LWORK .LT. LWORKREQ ) THEN - INFO = -26 + INFO = -25 END IF IF( INFO.NE.0 ) THEN @@ -297,7 +296,6 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Get machine constants SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( N )/ULP ) @@ -320,7 +318,8 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Store window in case of convergence failure CALL ZLACPY( 'ALL', JW, JW, A( KWTOP, KWTOP ), LDA, WORK, JW ) - CALL ZLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, WORK( JW**2+ + CALL ZLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, + $ WORK( JW**2+ $ 1 ), JW ) * Transform window to real schur form @@ -335,7 +334,8 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Convergence failure, restore the window and exit ND = 0 NS = JW-QZ_SMALL_INFO - CALL ZLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), LDA ) + CALL ZLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), + $ LDA ) CALL ZLACPY( 'ALL', JW, JW, WORK( JW**2+1 ), JW, B( KWTOP, $ KWTOP ), LDB ) RETURN @@ -392,11 +392,14 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A( K, KWTOP-1 ) = TEMP A( K+1, KWTOP-1 ) = CZERO K2 = MAX( KWTOP, K-1 ) - CALL ZROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, C1, + CALL ZROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, + $ C1, $ S1 ) - CALL ZROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, K-1 ), + CALL ZROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, + $ K-1 ), $ LDB, C1, S1 ) - CALL ZROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, K+1-KWTOP+1 ), + CALL ZROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, + $ K+1-KWTOP+1 ), $ 1, C1, DCONJG( S1 ) ) END DO @@ -438,25 +441,29 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, $ IHI+1 ), LDB ) END IF IF ( ILQ ) THEN - CALL ZGEMM( 'N', 'N', N, JW, JW, CONE, Q( 1, KWTOP ), LDQ, QC, + CALL ZGEMM( 'N', 'N', N, JW, JW, CONE, Q( 1, KWTOP ), LDQ, + $ QC, $ LDQC, CZERO, WORK, N ) CALL ZLACPY( 'ALL', N, JW, WORK, N, Q( 1, KWTOP ), LDQ ) END IF IF ( KWTOP-1-ISTARTM+1 > 0 ) THEN - CALL ZGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, A( ISTARTM, + CALL ZGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, + $ A( ISTARTM, $ KWTOP ), LDA, ZC, LDZC, CZERO, WORK, $ KWTOP-ISTARTM ) CALL ZLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ A( ISTARTM, KWTOP ), LDA ) - CALL ZGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, B( ISTARTM, + CALL ZGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, + $ B( ISTARTM, $ KWTOP ), LDB, ZC, LDZC, CZERO, WORK, $ KWTOP-ISTARTM ) CALL ZLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ B( ISTARTM, KWTOP ), LDB ) END IF IF ( ILZ ) THEN - CALL ZGEMM( 'N', 'N', N, JW, JW, CONE, Z( 1, KWTOP ), LDZ, ZC, + CALL ZGEMM( 'N', 'N', N, JW, JW, CONE, Z( 1, KWTOP ), LDZ, + $ ZC, $ LDZC, CZERO, WORK, N ) CALL ZLACPY( 'ALL', N, JW, WORK, N, Z( 1, KWTOP ), LDZ ) END IF diff --git a/lapack-netlib/SRC/zunbdb4.f b/lapack-netlib/SRC/zunbdb4.f index 31d8ec40b7..0a99949aaf 100644 --- a/lapack-netlib/SRC/zunbdb4.f +++ b/lapack-netlib/SRC/zunbdb4.f @@ -280,7 +280,7 @@ SUBROUTINE ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, LWORKMIN = LWORKOPT WORK(1) = LWORKOPT IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN - INFO = -14 + INFO = -15 END IF END IF IF( INFO .NE. 0 ) THEN diff --git a/lapack-netlib/SRC/zuncsd.f b/lapack-netlib/SRC/zuncsd.f index cc45bbc70b..81c09e7d72 100644 --- a/lapack-netlib/SRC/zuncsd.f +++ b/lapack-netlib/SRC/zuncsd.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZUNCSD + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -308,15 +306,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16OTHERcomputational +*> \ingroup uncsd * * ===================================================================== - RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, + RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, + $ TRANS, $ SIGNS, M, P, Q, X11, LDX11, X12, $ LDX12, X21, LDX21, X22, LDX22, THETA, $ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, WORK, LWORK, RWORK, LRWORK, $ IWORK, INFO ) + IMPLICIT NONE * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -360,7 +360,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, LOGICAL LRQUERY * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZBBCSD, ZLACPY, ZLAPMR, ZLAPMT, + EXTERNAL XERBLA, ZBBCSD, ZLACPY, ZLAPMR, + $ ZLAPMT, $ ZUNBDB, ZUNGLQ, ZUNGQR * .. * .. External Functions .. @@ -428,7 +429,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE SIGNST = 'D' END IF - CALL ZUNCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, M, + CALL ZUNCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, + $ M, $ Q, P, X11, LDX11, X21, LDX21, X12, LDX12, X22, $ LDX22, THETA, V1T, LDV1T, V2T, LDV2T, U1, LDU1, $ U2, LDU2, WORK, LWORK, RWORK, LRWORK, IWORK, @@ -508,10 +510,10 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * IF( LWORK .LT. LWORKMIN $ .AND. .NOT. ( LQUERY .OR. LRQUERY ) ) THEN - INFO = -22 + INFO = -28 ELSE IF( LRWORK .LT. LRWORKMIN $ .AND. .NOT. ( LQUERY .OR. LRQUERY ) ) THEN - INFO = -24 + INFO = -30 ELSE LORGQRWORK = LWORK - IORGQR + 1 LORGLQWORK = LWORK - IORGLQ + 1 @@ -531,7 +533,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Transform to bidiagonal block form * - CALL ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21, + CALL ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + $ X21, $ LDX21, X22, LDX22, THETA, RWORK(IPHI), WORK(ITAUP1), $ WORK(ITAUP2), WORK(ITAUQ1), WORK(ITAUQ2), $ WORK(IORBDB), LORBDBWORK, CHILDINFO ) @@ -541,7 +544,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, IF( COLMAJOR ) THEN IF( WANTU1 .AND. P .GT. 0 ) THEN CALL ZLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL ZUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL ZUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQRWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -557,7 +561,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL ZUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL ZUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -574,7 +579,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE IF( WANTU1 .AND. P .GT. 0 ) THEN CALL ZLACPY( 'U', Q, P, X11, LDX11, U1, LDU1 ) - CALL ZUNGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGLQ), + CALL ZUNGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGLQ), $ LORGLQWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -590,7 +596,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL ZUNGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL ZUNGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGQR), LORGQRWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -608,7 +615,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Compute the CSD of the matrix in bidiagonal-block form * - CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, THETA, + CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + $ THETA, $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E),