|
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431 |
- *> \brief \b DGET32
- *
- * =========== DOCUMENTATION ===========
- *
- * Online html documentation available at
- * http://www.netlib.org/lapack/explore-html/
- *
- * Definition:
- * ===========
- *
- * SUBROUTINE DGET32( RMAX, LMAX, NINFO, KNT )
- *
- * .. Scalar Arguments ..
- * INTEGER KNT, LMAX, NINFO
- * DOUBLE PRECISION RMAX
- * ..
- *
- *
- *> \par Purpose:
- * =============
- *>
- *> \verbatim
- *>
- *> DGET32 tests DLASY2, a routine for solving
- *>
- *> op(TL)*X + ISGN*X*op(TR) = SCALE*B
- *>
- *> where TL is N1 by N1, TR is N2 by N2, and N1,N2 =1 or 2 only.
- *> X and B are N1 by N2, op() is an optional transpose, an
- *> ISGN = 1 or -1. SCALE is chosen less than or equal to 1 to
- *> avoid overflow in X.
- *>
- *> The test condition is that the scaled residual
- *>
- *> norm( op(TL)*X + ISGN*X*op(TR) = SCALE*B )
- *> / ( max( ulp*norm(TL), ulp*norm(TR)) * norm(X), SMLNUM )
- *>
- *> should be on the order of 1. Here, ulp is the machine precision.
- *> Also, it is verified that SCALE is less than or equal to 1, and
- *> that XNORM = infinity-norm(X).
- *> \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 returned with INFO.NE.0.
- *> \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 double_eig
- *
- * =====================================================================
- SUBROUTINE DGET32( 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
- DOUBLE PRECISION RMAX
- * ..
- *
- * =====================================================================
- *
- * .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
- DOUBLE PRECISION TWO, FOUR, EIGHT
- PARAMETER ( TWO = 2.0D0, FOUR = 4.0D0, EIGHT = 8.0D0 )
- * ..
- * .. Local Scalars ..
- LOGICAL LTRANL, LTRANR
- INTEGER IB, IB1, IB2, IB3, INFO, ISGN, ITL, ITLSCL,
- $ ITR, ITRANL, ITRANR, ITRSCL, N1, N2
- DOUBLE PRECISION BIGNUM, DEN, EPS, RES, SCALE, SGN, SMLNUM, TMP,
- $ TNRM, XNORM, XNRM
- * ..
- * .. Local Arrays ..
- INTEGER ITVAL( 2, 2, 8 )
- DOUBLE PRECISION B( 2, 2 ), TL( 2, 2 ), TR( 2, 2 ), VAL( 3 ),
- $ X( 2, 2 )
- * ..
- * .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
- * ..
- * .. External Subroutines ..
- EXTERNAL DLABAD, DLASY2
- * ..
- * .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
- * ..
- * .. Data statements ..
- DATA ITVAL / 8, 4, 2, 1, 4, 8, 1, 2, 2, 1, 8, 4, 1,
- $ 2, 4, 8, 9, 4, 2, 1, 4, 9, 1, 2, 2, 1, 9, 4, 1,
- $ 2, 4, 9 /
- * ..
- * .. Executable Statements ..
- *
- * Get machine parameters
- *
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
- *
- * Set up test case parameters
- *
- VAL( 1 ) = SQRT( SMLNUM )
- VAL( 2 ) = ONE
- VAL( 3 ) = SQRT( BIGNUM )
- *
- KNT = 0
- NINFO = 0
- LMAX = 0
- RMAX = ZERO
- *
- * Begin test loop
- *
- DO 230 ITRANL = 0, 1
- DO 220 ITRANR = 0, 1
- DO 210 ISGN = -1, 1, 2
- SGN = ISGN
- LTRANL = ITRANL.EQ.1
- LTRANR = ITRANR.EQ.1
- *
- N1 = 1
- N2 = 1
- DO 30 ITL = 1, 3
- DO 20 ITR = 1, 3
- DO 10 IB = 1, 3
- TL( 1, 1 ) = VAL( ITL )
- TR( 1, 1 ) = VAL( ITR )
- B( 1, 1 ) = VAL( IB )
- KNT = KNT + 1
- CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL,
- $ 2, TR, 2, B, 2, SCALE, X, 2, XNORM,
- $ INFO )
- IF( INFO.NE.0 )
- $ NINFO = NINFO + 1
- RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )*
- $ X( 1, 1 )-SCALE*B( 1, 1 ) )
- IF( INFO.EQ.0 ) THEN
- DEN = MAX( EPS*( ( ABS( TR( 1,
- $ 1 ) )+ABS( TL( 1, 1 ) ) )*ABS( X( 1,
- $ 1 ) ) ), SMLNUM )
- ELSE
- DEN = SMLNUM*MAX( ABS( X( 1, 1 ) ), ONE )
- END IF
- RES = RES / DEN
- IF( SCALE.GT.ONE )
- $ RES = RES + ONE / EPS
- RES = RES + ABS( XNORM-ABS( X( 1, 1 ) ) ) /
- $ MAX( SMLNUM, XNORM ) / EPS
- IF( INFO.NE.0 .AND. INFO.NE.1 )
- $ RES = RES + ONE / EPS
- IF( RES.GT.RMAX ) THEN
- LMAX = KNT
- RMAX = RES
- END IF
- 10 CONTINUE
- 20 CONTINUE
- 30 CONTINUE
- *
- N1 = 2
- N2 = 1
- DO 80 ITL = 1, 8
- DO 70 ITLSCL = 1, 3
- DO 60 ITR = 1, 3
- DO 50 IB1 = 1, 3
- DO 40 IB2 = 1, 3
- B( 1, 1 ) = VAL( IB1 )
- B( 2, 1 ) = -FOUR*VAL( IB2 )
- TL( 1, 1 ) = ITVAL( 1, 1, ITL )*
- $ VAL( ITLSCL )
- TL( 2, 1 ) = ITVAL( 2, 1, ITL )*
- $ VAL( ITLSCL )
- TL( 1, 2 ) = ITVAL( 1, 2, ITL )*
- $ VAL( ITLSCL )
- TL( 2, 2 ) = ITVAL( 2, 2, ITL )*
- $ VAL( ITLSCL )
- TR( 1, 1 ) = VAL( ITR )
- KNT = KNT + 1
- CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2,
- $ TL, 2, TR, 2, B, 2, SCALE, X,
- $ 2, XNORM, INFO )
- IF( INFO.NE.0 )
- $ NINFO = NINFO + 1
- IF( LTRANL ) THEN
- TMP = TL( 1, 2 )
- TL( 1, 2 ) = TL( 2, 1 )
- TL( 2, 1 ) = TMP
- END IF
- RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )*
- $ X( 1, 1 )+TL( 1, 2 )*X( 2, 1 )-
- $ SCALE*B( 1, 1 ) )
- RES = RES + ABS( ( TL( 2, 2 )+SGN*TR( 1,
- $ 1 ) )*X( 2, 1 )+TL( 2, 1 )*
- $ X( 1, 1 )-SCALE*B( 2, 1 ) )
- TNRM = ABS( TR( 1, 1 ) ) +
- $ ABS( TL( 1, 1 ) ) +
- $ ABS( TL( 1, 2 ) ) +
- $ ABS( TL( 2, 1 ) ) +
- $ ABS( TL( 2, 2 ) )
- XNRM = MAX( ABS( X( 1, 1 ) ),
- $ ABS( X( 2, 1 ) ) )
- DEN = MAX( SMLNUM, SMLNUM*XNRM,
- $ ( TNRM*EPS )*XNRM )
- RES = RES / DEN
- IF( SCALE.GT.ONE )
- $ RES = RES + ONE / EPS
- RES = RES + ABS( XNORM-XNRM ) /
- $ MAX( SMLNUM, XNORM ) / EPS
- IF( RES.GT.RMAX ) THEN
- LMAX = KNT
- RMAX = RES
- END IF
- 40 CONTINUE
- 50 CONTINUE
- 60 CONTINUE
- 70 CONTINUE
- 80 CONTINUE
- *
- N1 = 1
- N2 = 2
- DO 130 ITR = 1, 8
- DO 120 ITRSCL = 1, 3
- DO 110 ITL = 1, 3
- DO 100 IB1 = 1, 3
- DO 90 IB2 = 1, 3
- B( 1, 1 ) = VAL( IB1 )
- B( 1, 2 ) = -TWO*VAL( IB2 )
- TR( 1, 1 ) = ITVAL( 1, 1, ITR )*
- $ VAL( ITRSCL )
- TR( 2, 1 ) = ITVAL( 2, 1, ITR )*
- $ VAL( ITRSCL )
- TR( 1, 2 ) = ITVAL( 1, 2, ITR )*
- $ VAL( ITRSCL )
- TR( 2, 2 ) = ITVAL( 2, 2, ITR )*
- $ VAL( ITRSCL )
- TL( 1, 1 ) = VAL( ITL )
- KNT = KNT + 1
- CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2,
- $ TL, 2, TR, 2, B, 2, SCALE, X,
- $ 2, XNORM, INFO )
- IF( INFO.NE.0 )
- $ NINFO = NINFO + 1
- IF( LTRANR ) THEN
- TMP = TR( 1, 2 )
- TR( 1, 2 ) = TR( 2, 1 )
- TR( 2, 1 ) = TMP
- END IF
- TNRM = ABS( TL( 1, 1 ) ) +
- $ ABS( TR( 1, 1 ) ) +
- $ ABS( TR( 1, 2 ) ) +
- $ ABS( TR( 2, 2 ) ) +
- $ ABS( TR( 2, 1 ) )
- XNRM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
- RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1,
- $ 1 ) ) )*( X( 1, 1 ) )+
- $ ( SGN*TR( 2, 1 ) )*( X( 1, 2 ) )-
- $ ( SCALE*B( 1, 1 ) ) )
- RES = RES + ABS( ( ( TL( 1, 1 )+SGN*TR( 2,
- $ 2 ) ) )*( X( 1, 2 ) )+
- $ ( SGN*TR( 1, 2 ) )*( X( 1, 1 ) )-
- $ ( SCALE*B( 1, 2 ) ) )
- DEN = MAX( SMLNUM, SMLNUM*XNRM,
- $ ( TNRM*EPS )*XNRM )
- RES = RES / DEN
- IF( SCALE.GT.ONE )
- $ RES = RES + ONE / EPS
- RES = RES + ABS( XNORM-XNRM ) /
- $ MAX( SMLNUM, XNORM ) / EPS
- IF( RES.GT.RMAX ) THEN
- LMAX = KNT
- RMAX = RES
- END IF
- 90 CONTINUE
- 100 CONTINUE
- 110 CONTINUE
- 120 CONTINUE
- 130 CONTINUE
- *
- N1 = 2
- N2 = 2
- DO 200 ITR = 1, 8
- DO 190 ITRSCL = 1, 3
- DO 180 ITL = 1, 8
- DO 170 ITLSCL = 1, 3
- DO 160 IB1 = 1, 3
- DO 150 IB2 = 1, 3
- DO 140 IB3 = 1, 3
- B( 1, 1 ) = VAL( IB1 )
- B( 2, 1 ) = -FOUR*VAL( IB2 )
- B( 1, 2 ) = -TWO*VAL( IB3 )
- B( 2, 2 ) = EIGHT*
- $ MIN( VAL( IB1 ), VAL
- $ ( IB2 ), VAL( IB3 ) )
- TR( 1, 1 ) = ITVAL( 1, 1, ITR )*
- $ VAL( ITRSCL )
- TR( 2, 1 ) = ITVAL( 2, 1, ITR )*
- $ VAL( ITRSCL )
- TR( 1, 2 ) = ITVAL( 1, 2, ITR )*
- $ VAL( ITRSCL )
- TR( 2, 2 ) = ITVAL( 2, 2, ITR )*
- $ VAL( ITRSCL )
- TL( 1, 1 ) = ITVAL( 1, 1, ITL )*
- $ VAL( ITLSCL )
- TL( 2, 1 ) = ITVAL( 2, 1, ITL )*
- $ VAL( ITLSCL )
- TL( 1, 2 ) = ITVAL( 1, 2, ITL )*
- $ VAL( ITLSCL )
- TL( 2, 2 ) = ITVAL( 2, 2, ITL )*
- $ VAL( ITLSCL )
- KNT = KNT + 1
- CALL DLASY2( LTRANL, LTRANR, ISGN,
- $ N1, N2, TL, 2, TR, 2,
- $ B, 2, SCALE, X, 2,
- $ XNORM, INFO )
- IF( INFO.NE.0 )
- $ NINFO = NINFO + 1
- IF( LTRANR ) THEN
- TMP = TR( 1, 2 )
- TR( 1, 2 ) = TR( 2, 1 )
- TR( 2, 1 ) = TMP
- END IF
- IF( LTRANL ) THEN
- TMP = TL( 1, 2 )
- TL( 1, 2 ) = TL( 2, 1 )
- TL( 2, 1 ) = TMP
- END IF
- TNRM = ABS( TR( 1, 1 ) ) +
- $ ABS( TR( 2, 1 ) ) +
- $ ABS( TR( 1, 2 ) ) +
- $ ABS( TR( 2, 2 ) ) +
- $ ABS( TL( 1, 1 ) ) +
- $ ABS( TL( 2, 1 ) ) +
- $ ABS( TL( 1, 2 ) ) +
- $ ABS( TL( 2, 2 ) )
- XNRM = MAX( ABS( X( 1, 1 ) )+
- $ ABS( X( 1, 2 ) ),
- $ ABS( X( 2, 1 ) )+
- $ ABS( X( 2, 2 ) ) )
- RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1,
- $ 1 ) ) )*( X( 1, 1 ) )+
- $ ( SGN*TR( 2, 1 ) )*
- $ ( X( 1, 2 ) )+( TL( 1, 2 ) )*
- $ ( X( 2, 1 ) )-
- $ ( SCALE*B( 1, 1 ) ) )
- RES = RES + ABS( ( TL( 1, 1 ) )*
- $ ( X( 1, 2 ) )+
- $ ( SGN*TR( 1, 2 ) )*
- $ ( X( 1, 1 ) )+
- $ ( SGN*TR( 2, 2 ) )*
- $ ( X( 1, 2 ) )+( TL( 1, 2 ) )*
- $ ( X( 2, 2 ) )-
- $ ( SCALE*B( 1, 2 ) ) )
- RES = RES + ABS( ( TL( 2, 1 ) )*
- $ ( X( 1, 1 ) )+
- $ ( SGN*TR( 1, 1 ) )*
- $ ( X( 2, 1 ) )+
- $ ( SGN*TR( 2, 1 ) )*
- $ ( X( 2, 2 ) )+( TL( 2, 2 ) )*
- $ ( X( 2, 1 ) )-
- $ ( SCALE*B( 2, 1 ) ) )
- RES = RES + ABS( ( ( TL( 2,
- $ 2 )+SGN*TR( 2, 2 ) ) )*
- $ ( X( 2, 2 ) )+
- $ ( SGN*TR( 1, 2 ) )*
- $ ( X( 2, 1 ) )+( TL( 2, 1 ) )*
- $ ( X( 1, 2 ) )-
- $ ( SCALE*B( 2, 2 ) ) )
- DEN = MAX( SMLNUM, SMLNUM*XNRM,
- $ ( TNRM*EPS )*XNRM )
- RES = RES / DEN
- IF( SCALE.GT.ONE )
- $ RES = RES + ONE / EPS
- RES = RES + ABS( XNORM-XNRM ) /
- $ MAX( SMLNUM, XNORM ) / EPS
- IF( RES.GT.RMAX ) THEN
- LMAX = KNT
- RMAX = RES
- END IF
- 140 CONTINUE
- 150 CONTINUE
- 160 CONTINUE
- 170 CONTINUE
- 180 CONTINUE
- 190 CONTINUE
- 200 CONTINUE
- 210 CONTINUE
- 220 CONTINUE
- 230 CONTINUE
- *
- RETURN
- *
- * End of DGET32
- *
- END
|
