OpenBLAS/lapack-netlib/TESTING/EIG/dget32.f

*> \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.
*
*> \ingroup double_eig
*
*  =====================================================================
      SUBROUTINE DGET32( RMAX, LMAX, NINFO, KNT )
*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. 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