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/dlaqz0.f b/lapack-netlib/SRC/dlaqz0.f index 84cb96bcb2..67da04824a 100644 --- a/lapack-netlib/SRC/dlaqz0.f +++ b/lapack-netlib/SRC/dlaqz0.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download DLAQZ0 + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -296,10 +294,11 @@ * *> \date May 2020 * -*> \ingroup doubleGEcomputational +*> \ingroup laqz0 *> * ===================================================================== - RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, + RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, + $ A, $ LDA, B, LDB, ALPHAR, ALPHAI, BETA, $ Q, LDQ, Z, LDZ, WORK, LWORK, REC, $ INFO ) @@ -439,7 +438,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, NBR = NSR+ITEMP1 IF( N .LT. NMIN .OR. REC .GE. 2 ) THEN - CALL DHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, LDB, + CALL DHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, + $ LDB, $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, $ LWORK, INFO ) RETURN @@ -451,7 +451,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Workspace query to dlaqz3 NW = MAX( NWR, NMIN ) - CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB, + CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, + $ LDB, $ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHAR, $ ALPHAI, BETA, WORK, NW, WORK, NW, WORK, -1, REC, $ AED_INFO ) @@ -470,14 +471,16 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, INFO = -19 END IF IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DLAQZ0', INFO ) + CALL XERBLA( 'DLAQZ0', -INFO ) RETURN END IF * * Initialize Q and Z * - IF( IWANTQ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Q, LDQ ) - IF( IWANTZ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Z, LDZ ) + IF( IWANTQ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Q, + $ LDQ ) + IF( IWANTZ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Z, + $ LDZ ) * Get machine constants SAFMIN = DLAMCH( 'SAFE MINIMUM' ) @@ -570,17 +573,20 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * to the top and deflate it DO K2 = K, ISTART2+1, -1 - CALL DLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1, + CALL DLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, + $ S1, $ TEMP ) B( K2-1, K2 ) = TEMP B( K2-1, K2-1 ) = ZERO CALL DROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1, $ B( ISTARTM, K2-1 ), 1, C1, S1 ) - CALL DROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM, + CALL DROT( MIN( K2+1, ISTOP )-ISTARTM+1, + $ A( ISTARTM, $ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 ) IF ( ILZ ) THEN - CALL DROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1, + CALL DROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, + $ C1, $ S1 ) END IF @@ -590,9 +596,11 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, A( K2, K2-1 ) = TEMP A( K2+1, K2-1 ) = ZERO - CALL DROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1, + CALL DROT( ISTOPM-K2+1, A( K2, K2 ), LDA, + $ A( K2+1, $ K2 ), LDA, C1, S1 ) - CALL DROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1, + CALL DROT( ISTOPM-K2+1, B( K2, K2 ), LDB, + $ B( K2+1, $ K2 ), LDB, C1, S1 ) IF( ILQ ) THEN CALL DROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1, @@ -654,7 +662,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for AED * - CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA, + CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, + $ LDA, $ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, $ ALPHAR, ALPHAI, BETA, WORK, NW, WORK( NW**2+1 ), $ NW, WORK( 2*NW**2+1 ), LWORK-2*NW**2, REC, @@ -724,7 +733,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for a QZ sweep * - CALL DLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK, + CALL DLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, + $ NBLOCK, $ ALPHAR( SHIFTPOS ), ALPHAI( SHIFTPOS ), $ BETA( SHIFTPOS ), A, LDA, B, LDB, Q, LDQ, Z, LDZ, $ WORK, NBLOCK, WORK( NBLOCK**2+1 ), NBLOCK, diff --git a/lapack-netlib/SRC/slaqz0.f b/lapack-netlib/SRC/slaqz0.f index c128093e43..2e1a263bd2 100644 --- a/lapack-netlib/SRC/slaqz0.f +++ b/lapack-netlib/SRC/slaqz0.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download SLAQZ0 + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -297,7 +295,8 @@ *> \ingroup laqz0 *> * ===================================================================== - RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, + RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, + $ A, $ LDA, B, LDB, ALPHAR, ALPHAI, BETA, $ Q, LDQ, Z, LDZ, WORK, LWORK, REC, $ INFO ) @@ -431,12 +430,14 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, NSR = MAX( 2, NSR-MOD( NSR, 2 ) ) RCOST = ILAENV( 17, 'SLAQZ0', 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 SHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, LDB, + CALL SHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, + $ LDB, $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, $ LWORK, INFO ) RETURN @@ -448,7 +449,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Workspace query to slaqz3 NW = MAX( NWR, NMIN ) - CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB, + CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, + $ LDB, $ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHAR, $ ALPHAI, BETA, WORK, NW, WORK, NW, WORK, -1, REC, $ AED_INFO ) @@ -467,14 +469,16 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, INFO = -19 END IF IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SLAQZ0', INFO ) + CALL XERBLA( 'SLAQZ0', -INFO ) RETURN END IF * * Initialize Q and Z * - IF( IWANTQ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Q, LDQ ) - IF( IWANTZ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Z, LDZ ) + IF( IWANTQ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Q, + $ LDQ ) + IF( IWANTZ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Z, + $ LDZ ) * Get machine constants SAFMIN = SLAMCH( 'SAFE MINIMUM' ) @@ -567,17 +571,20 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * to the top and deflate it DO K2 = K, ISTART2+1, -1 - CALL SLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1, + CALL SLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, + $ S1, $ TEMP ) B( K2-1, K2 ) = TEMP B( K2-1, K2-1 ) = ZERO CALL SROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1, $ B( ISTARTM, K2-1 ), 1, C1, S1 ) - CALL SROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM, + CALL SROT( MIN( K2+1, ISTOP )-ISTARTM+1, + $ A( ISTARTM, $ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 ) IF ( ILZ ) THEN - CALL SROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1, + CALL SROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, + $ C1, $ S1 ) END IF @@ -587,9 +594,11 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, A( K2, K2-1 ) = TEMP A( K2+1, K2-1 ) = ZERO - CALL SROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1, + CALL SROT( ISTOPM-K2+1, A( K2, K2 ), LDA, + $ A( K2+1, $ K2 ), LDA, C1, S1 ) - CALL SROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1, + CALL SROT( ISTOPM-K2+1, B( K2, K2 ), LDB, + $ B( K2+1, $ K2 ), LDB, C1, S1 ) IF( ILQ ) THEN CALL SROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1, @@ -651,7 +660,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for AED * - CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA, + CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, + $ LDA, $ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, $ ALPHAR, ALPHAI, BETA, WORK, NW, WORK( NW**2+1 ), $ NW, WORK( 2*NW**2+1 ), LWORK-2*NW**2, REC, @@ -721,7 +731,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for a QZ sweep * - CALL SLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK, + CALL SLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, + $ NBLOCK, $ ALPHAR( SHIFTPOS ), ALPHAI( SHIFTPOS ), $ BETA( SHIFTPOS ), A, LDA, B, LDB, Q, LDQ, Z, LDZ, $ WORK, NBLOCK, WORK( NBLOCK**2+1 ), NBLOCK, 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 ),