*> \brief \b SGET35 * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * * Definition: * =========== * * SUBROUTINE SGET35( RMAX, LMAX, NINFO, KNT ) * * .. Scalar Arguments .. * INTEGER KNT, LMAX, NINFO * REAL RMAX * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> SGET35 tests STRSYL, a routine for solving the Sylvester matrix *> equation *> *> op(A)*X + ISGN*X*op(B) = scale*C, *> *> A and B are assumed to be in Schur canonical form, op() represents an *> optional transpose, and ISGN can be -1 or +1. Scale is an output *> less than or equal to 1, chosen to avoid overflow in X. *> *> The test code verifies that the following residual is order 1: *> *> norm(op(A)*X + ISGN*X*op(B) - scale*C) / *> (EPS*max(norm(A),norm(B))*norm(X)) *> \endverbatim * * Arguments: * ========== * *> \param[out] RMAX *> \verbatim *> RMAX is REAL *> 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 * * Authors: * ======== * *> \author Univ. of Tennessee *> \author Univ. of California Berkeley *> \author Univ. of Colorado Denver *> \author NAG Ltd. * *> \date December 2016 * *> \ingroup single_eig * * ===================================================================== SUBROUTINE SGET35( RMAX, LMAX, NINFO, KNT ) * * -- LAPACK test routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * * .. Scalar Arguments .. INTEGER KNT, LMAX, NINFO REAL RMAX * .. * * ===================================================================== * * .. Parameters .. REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) REAL TWO, FOUR PARAMETER ( TWO = 2.0E0, FOUR = 4.0E0 ) * .. * .. Local Scalars .. CHARACTER TRANA, TRANB INTEGER I, IMA, IMB, IMLDA1, IMLDA2, IMLDB1, IMLOFF, $ INFO, ISGN, ITRANA, ITRANB, J, M, N REAL BIGNUM, CNRM, EPS, RES, RES1, RMUL, SCALE, $ SMLNUM, TNRM, XNRM * .. * .. Local Arrays .. INTEGER IDIM( 8 ), IVAL( 6, 6, 8 ) REAL A( 6, 6 ), B( 6, 6 ), C( 6, 6 ), CC( 6, 6 ), $ DUM( 1 ), VM1( 3 ), VM2( 3 ) * .. * .. External Functions .. REAL SLAMCH, SLANGE EXTERNAL SLAMCH, SLANGE * .. * .. External Subroutines .. EXTERNAL SGEMM, STRSYL * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, REAL, SIN, SQRT * .. * .. Data statements .. DATA IDIM / 1, 2, 3, 4, 3, 3, 6, 4 / DATA IVAL / 1, 35*0, 1, 2, 4*0, -2, 0, 28*0, 1, 5*0, $ 5, 1, 2, 3*0, -8, -2, 1, 21*0, 3, 4, 4*0, -5, $ 3, 4*0, 1, 2, 1, 4, 2*0, -3, -9, -1, 1, 14*0, $ 1, 5*0, 2, 3, 4*0, 5, 6, 7, 21*0, 1, 5*0, 1, 3, $ -4, 3*0, 2, 5, 2, 21*0, 1, 2, 4*0, -2, 0, 4*0, $ 5, 6, 3, 4, 2*0, -1, -9, -5, 2, 2*0, 4*8, 5, 6, $ 4*9, -7, 5, 1, 5*0, 1, 5, 2, 3*0, 2, -21, 5, $ 3*0, 1, 2, 3, 4, 14*0 / * .. * .. Executable Statements .. * * Get machine parameters * EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' )*FOUR / EPS BIGNUM = ONE / SMLNUM CALL SLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * VM1( 1 ) = SQRT( SMLNUM ) VM1( 2 ) = ONE VM1( 3 ) = SQRT( BIGNUM ) VM2( 1 ) = ONE VM2( 2 ) = ONE + TWO*EPS VM2( 3 ) = TWO * KNT = 0 NINFO = 0 LMAX = 0 RMAX = ZERO * * Begin test loop * DO 150 ITRANA = 1, 2 DO 140 ITRANB = 1, 2 DO 130 ISGN = -1, 1, 2 DO 120 IMA = 1, 8 DO 110 IMLDA1 = 1, 3 DO 100 IMLDA2 = 1, 3 DO 90 IMLOFF = 1, 2 DO 80 IMB = 1, 8 DO 70 IMLDB1 = 1, 3 IF( ITRANA.EQ.1 ) $ TRANA = 'N' IF( ITRANA.EQ.2 ) $ TRANA = 'T' IF( ITRANB.EQ.1 ) $ TRANB = 'N' IF( ITRANB.EQ.2 ) $ TRANB = 'T' M = IDIM( IMA ) N = IDIM( IMB ) TNRM = ZERO DO 20 I = 1, M DO 10 J = 1, M A( I, J ) = IVAL( I, J, IMA ) IF( ABS( I-J ).LE.1 ) THEN A( I, J ) = A( I, J )* $ VM1( IMLDA1 ) A( I, J ) = A( I, J )* $ VM2( IMLDA2 ) ELSE A( I, J ) = A( I, J )* $ VM1( IMLOFF ) END IF TNRM = MAX( TNRM, $ ABS( A( I, J ) ) ) 10 CONTINUE 20 CONTINUE DO 40 I = 1, N DO 30 J = 1, N B( I, J ) = IVAL( I, J, IMB ) IF( ABS( I-J ).LE.1 ) THEN B( I, J ) = B( I, J )* $ VM1( IMLDB1 ) ELSE B( I, J ) = B( I, J )* $ VM1( IMLOFF ) END IF TNRM = MAX( TNRM, $ ABS( B( I, J ) ) ) 30 CONTINUE 40 CONTINUE CNRM = ZERO DO 60 I = 1, M DO 50 J = 1, N C( I, J ) = SIN( REAL( I*J ) ) CNRM = MAX( CNRM, C( I, J ) ) CC( I, J ) = C( I, J ) 50 CONTINUE 60 CONTINUE KNT = KNT + 1 CALL STRSYL( TRANA, TRANB, ISGN, M, N, $ A, 6, B, 6, C, 6, SCALE, $ INFO ) IF( INFO.NE.0 ) $ NINFO = NINFO + 1 XNRM = SLANGE( 'M', M, N, C, 6, DUM ) RMUL = ONE IF( XNRM.GT.ONE .AND. TNRM.GT.ONE ) $ THEN IF( XNRM.GT.BIGNUM / TNRM ) THEN RMUL = ONE / MAX( XNRM, TNRM ) END IF END IF CALL SGEMM( TRANA, 'N', M, N, M, RMUL, $ A, 6, C, 6, -SCALE*RMUL, $ CC, 6 ) CALL SGEMM( 'N', TRANB, M, N, N, $ REAL( ISGN )*RMUL, C, 6, B, $ 6, ONE, CC, 6 ) RES1 = SLANGE( 'M', M, N, CC, 6, DUM ) RES = RES1 / MAX( SMLNUM, SMLNUM*XNRM, $ ( ( RMUL*TNRM )*EPS )*XNRM ) IF( RES.GT.RMAX ) THEN LMAX = KNT RMAX = RES END IF 70 CONTINUE 80 CONTINUE 90 CONTINUE 100 CONTINUE 110 CONTINUE 120 CONTINUE 130 CONTINUE 140 CONTINUE 150 CONTINUE * RETURN * * End of SGET35 * END