sget32.f

来自「famous linear algebra library (LAPACK) p」· F 代码 · 共 385 行 · 第 1/2 页

      SUBROUTINE SGET32( RMAX, LMAX, NINFO, KNT )
*
*  -- LAPACK test routine (version 3.1) --
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
*     November 2006
*
*     .. Scalar Arguments ..
      INTEGER            KNT, LMAX, NINFO
      REAL               RMAX
*     ..
*
*  Purpose
*  =======
*
*  SGET32 tests SLASY2, 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).
*
*  Arguments
*  ==========
*
*  RMAX    (output) REAL
*          Value of the largest test ratio.
*
*  LMAX    (output) INTEGER
*          Example number where largest test ratio achieved.
*
*  NINFO   (output) INTEGER
*          Number of examples returned with INFO.NE.0.
*
*  KNT     (output) INTEGER
*          Total number of examples tested.
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE
      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
      REAL               TWO, FOUR, EIGHT
      PARAMETER          ( TWO = 2.0E0, FOUR = 4.0E0, EIGHT = 8.0E0 )
*     ..
*     .. Local Scalars ..
      LOGICAL            LTRANL, LTRANR
      INTEGER            IB, IB1, IB2, IB3, INFO, ISGN, ITL, ITLSCL,
     $                   ITR, ITRANL, ITRANR, ITRSCL, N1, N2
      REAL               BIGNUM, DEN, EPS, RES, SCALE, SGN, SMLNUM, TMP,
     $                   TNRM, XNORM, XNRM
*     ..
*     .. Local Arrays ..
      INTEGER            ITVAL( 2, 2, 8 )
      REAL               B( 2, 2 ), TL( 2, 2 ), TR( 2, 2 ), VAL( 3 ),
     $                   X( 2, 2 )
*     ..
*     .. External Functions ..
      REAL               SLAMCH
      EXTERNAL           SLAMCH
*     ..
*     .. External Subroutines ..
      EXTERNAL           SLABAD, SLASY2
*     ..
*     .. 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 = SLAMCH( 'P' )
      SMLNUM = SLAMCH( 'S' ) / EPS
      BIGNUM = ONE / SMLNUM
      CALL SLABAD( 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 SLASY2( 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 SLASY2( 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 )