*> \brief \b ZGET36 * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * * Definition: * =========== * * SUBROUTINE ZGET36( RMAX, LMAX, NINFO, KNT, NIN ) * * .. Scalar Arguments .. * INTEGER KNT, LMAX, NIN, NINFO * DOUBLE PRECISION RMAX * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> ZGET36 tests ZTREXC, a routine for reordering diagonal entries of a *> matrix in complex Schur form. Thus, ZLAEXC computes a unitary matrix *> Q such that *> *> Q' * T1 * Q = T2 *> *> and where one of the diagonal blocks of T1 (the one at row IFST) has *> been moved to position ILST. *> *> The test code verifies that the residual Q'*T1*Q-T2 is small, that T2 *> is in Schur form, and that the final position of the IFST block is *> ILST. *> *> The test matrices are read from a file with logical unit number NIN. *> \endverbatim * * Arguments: * ========== * *> \param[out] RMAX *> \verbatim *> RMAX is DOUBLE PRECISION *> Value of the largest test ratio. *> \endverbatim *> *> \param[out] LMAX *> \verbatim *> LMAX is INTEGER *> Example number where largest test ratio achieved. *> \endverbatim *> *> \param[out] NINFO *> \verbatim *> NINFO is INTEGER *> Number of examples where INFO is nonzero. *> \endverbatim *> *> \param[out] KNT *> \verbatim *> KNT is INTEGER *> Total number of examples tested. *> \endverbatim *> *> \param[in] NIN *> \verbatim *> NIN is INTEGER *> Input logical unit number. *> \endverbatim * * Authors: * ======== * *> \author Univ. of Tennessee *> \author Univ. of California Berkeley *> \author Univ. of Colorado Denver *> \author NAG Ltd. * *> \date November 2011 * *> \ingroup complex16_eig * * ===================================================================== SUBROUTINE ZGET36( RMAX, LMAX, NINFO, KNT, NIN ) * * -- LAPACK test routine (version 3.4.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2011 * * .. Scalar Arguments .. INTEGER KNT, LMAX, NIN, NINFO DOUBLE PRECISION RMAX * .. * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) COMPLEX*16 CZERO, CONE PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), $ CONE = ( 1.0D+0, 0.0D+0 ) ) INTEGER LDT, LWORK PARAMETER ( LDT = 10, LWORK = 2*LDT*LDT ) * .. * .. Local Scalars .. INTEGER I, IFST, ILST, INFO1, INFO2, J, N DOUBLE PRECISION EPS, RES COMPLEX*16 CTEMP * .. * .. Local Arrays .. DOUBLE PRECISION RESULT( 2 ), RWORK( LDT ) COMPLEX*16 DIAG( LDT ), Q( LDT, LDT ), T1( LDT, LDT ), $ T2( LDT, LDT ), TMP( LDT, LDT ), WORK( LWORK ) * .. * .. External Functions .. DOUBLE PRECISION DLAMCH EXTERNAL DLAMCH * .. * .. External Subroutines .. EXTERNAL ZCOPY, ZHST01, ZLACPY, ZLASET, ZTREXC * .. * .. Executable Statements .. * EPS = DLAMCH( 'P' ) RMAX = ZERO LMAX = 0 KNT = 0 NINFO = 0 * * Read input data until N=0 * 10 CONTINUE READ( NIN, FMT = * )N, IFST, ILST IF( N.EQ.0 ) $ RETURN KNT = KNT + 1 DO 20 I = 1, N READ( NIN, FMT = * )( TMP( I, J ), J = 1, N ) 20 CONTINUE CALL ZLACPY( 'F', N, N, TMP, LDT, T1, LDT ) CALL ZLACPY( 'F', N, N, TMP, LDT, T2, LDT ) RES = ZERO * * Test without accumulating Q * CALL ZLASET( 'Full', N, N, CZERO, CONE, Q, LDT ) CALL ZTREXC( 'N', N, T1, LDT, Q, LDT, IFST, ILST, INFO1 ) DO 40 I = 1, N DO 30 J = 1, N IF( I.EQ.J .AND. Q( I, J ).NE.CONE ) $ RES = RES + ONE / EPS IF( I.NE.J .AND. Q( I, J ).NE.CZERO ) $ RES = RES + ONE / EPS 30 CONTINUE 40 CONTINUE * * Test with accumulating Q * CALL ZLASET( 'Full', N, N, CZERO, CONE, Q, LDT ) CALL ZTREXC( 'V', N, T2, LDT, Q, LDT, IFST, ILST, INFO2 ) * * Compare T1 with T2 * DO 60 I = 1, N DO 50 J = 1, N IF( T1( I, J ).NE.T2( I, J ) ) $ RES = RES + ONE / EPS 50 CONTINUE 60 CONTINUE IF( INFO1.NE.0 .OR. INFO2.NE.0 ) $ NINFO = NINFO + 1 IF( INFO1.NE.INFO2 ) $ RES = RES + ONE / EPS * * Test for successful reordering of T2 * CALL ZCOPY( N, TMP, LDT+1, DIAG, 1 ) IF( IFST.LT.ILST ) THEN DO 70 I = IFST + 1, ILST CTEMP = DIAG( I ) DIAG( I ) = DIAG( I-1 ) DIAG( I-1 ) = CTEMP 70 CONTINUE ELSE IF( IFST.GT.ILST ) THEN DO 80 I = IFST - 1, ILST, -1 CTEMP = DIAG( I+1 ) DIAG( I+1 ) = DIAG( I ) DIAG( I ) = CTEMP 80 CONTINUE END IF DO 90 I = 1, N IF( T2( I, I ).NE.DIAG( I ) ) $ RES = RES + ONE / EPS 90 CONTINUE * * Test for small residual, and orthogonality of Q * CALL ZHST01( N, 1, N, TMP, LDT, T2, LDT, Q, LDT, WORK, LWORK, $ RWORK, RESULT ) RES = RES + RESULT( 1 ) + RESULT( 2 ) * * Test for T2 being in Schur form * DO 110 J = 1, N - 1 DO 100 I = J + 1, N IF( T2( I, J ).NE.CZERO ) $ RES = RES + ONE / EPS 100 CONTINUE 110 CONTINUE IF( RES.GT.RMAX ) THEN RMAX = RES LMAX = KNT END IF GO TO 10 * * End of ZGET36 * END