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

*> \brief \b SGET34
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*  Definition:
*  ===========
*
*       SUBROUTINE SGET34( RMAX, LMAX, NINFO, KNT )
*
*       .. Scalar Arguments ..
*       INTEGER            KNT, LMAX
*       REAL               RMAX
*       ..
*       .. Array Arguments ..
*       INTEGER            NINFO( 2 )
*       ..
*
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> SGET34 tests SLAEXC, a routine for swapping adjacent blocks (either
*> 1 by 1 or 2 by 2) on the diagonal of a matrix in real Schur form.
*> Thus, SLAEXC computes an orthogonal matrix Q such that
*>
*>     Q' * [ A B ] * Q  = [ C1 B1 ]
*>          [ 0 C ]        [ 0  A1 ]
*>
*> where C1 is similar to C and A1 is similar to A.  Both A and C are
*> assumed to be in standard form (equal diagonal entries and
*> offdiagonal with differing signs) and A1 and C1 are returned with the
*> same properties.
*>
*> The test code verifies these last last assertions, as well as that
*> the residual in the above equation is small.
*> \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 array, dimension (2)
*>          NINFO(J) is the number of examples where INFO=J occurred.
*> \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 single_eig
*
*  =====================================================================
      SUBROUTINE SGET34( 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
      REAL               RMAX
*     ..
*     .. Array Arguments ..
      INTEGER            NINFO( 2 )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, HALF, ONE
      PARAMETER          ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0 )
      REAL               TWO, THREE
      PARAMETER          ( TWO = 2.0E0, THREE = 3.0E0 )
      INTEGER            LWORK
      PARAMETER          ( LWORK = 32 )
*     ..
*     .. Local Scalars ..
      INTEGER            I, IA, IA11, IA12, IA21, IA22, IAM, IB, IC,
     $                   IC11, IC12, IC21, IC22, ICM, INFO, J
      REAL               BIGNUM, EPS, RES, SMLNUM, TNRM
*     ..
*     .. Local Arrays ..
      REAL               Q( 4, 4 ), RESULT( 2 ), T( 4, 4 ), T1( 4, 4 ),
     $                   VAL( 9 ), VM( 2 ), WORK( LWORK )
*     ..
*     .. External Functions ..
      REAL               SLAMCH
      EXTERNAL           SLAMCH
*     ..
*     .. External Subroutines ..
      EXTERNAL           SCOPY, SLAEXC
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          ABS, MAX, REAL, SIGN, SQRT
*     ..
*     .. 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 ) = ZERO
      VAL( 2 ) = SQRT( SMLNUM )
      VAL( 3 ) = ONE
      VAL( 4 ) = TWO
      VAL( 5 ) = SQRT( BIGNUM )
      VAL( 6 ) = -SQRT( SMLNUM )
      VAL( 7 ) = -ONE
      VAL( 8 ) = -TWO
      VAL( 9 ) = -SQRT( BIGNUM )
      VM( 1 ) = ONE
      VM( 2 ) = ONE + TWO*EPS
      CALL SCOPY( 16, VAL( 4 ), 0, T( 1, 1 ), 1 )
*
      NINFO( 1 ) = 0
      NINFO( 2 ) = 0
      KNT = 0
      LMAX = 0
      RMAX = ZERO
*
*     Begin test loop
*
      DO 40 IA = 1, 9
         DO 30 IAM = 1, 2
            DO 20 IB = 1, 9
               DO 10 IC = 1, 9
                  T( 1, 1 ) = VAL( IA )*VM( IAM )
                  T( 2, 2 ) = VAL( IC )
                  T( 1, 2 ) = VAL( IB )
                  T( 2, 1 ) = ZERO
                  TNRM = MAX( ABS( T( 1, 1 ) ), ABS( T( 2, 2 ) ),
     $                   ABS( T( 1, 2 ) ) )
                  CALL SCOPY( 16, T, 1, T1, 1 )
                  CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
                  CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
                  CALL SLAEXC( .TRUE., 2, T, 4, Q, 4, 1, 1, 1, WORK,
     $                         INFO )
                  IF( INFO.NE.0 )
     $               NINFO( INFO ) = NINFO( INFO ) + 1
                  CALL SHST01( 2, 1, 2, T1, 4, T, 4, Q, 4, WORK, LWORK,
     $                         RESULT )
                  RES = RESULT( 1 ) + RESULT( 2 )
                  IF( INFO.NE.0 )
     $               RES = RES + ONE / EPS
                  IF( T( 1, 1 ).NE.T1( 2, 2 ) )
     $               RES = RES + ONE / EPS
                  IF( T( 2, 2 ).NE.T1( 1, 1 ) )
     $               RES = RES + ONE / EPS
                  IF( T( 2, 1 ).NE.ZERO )
     $               RES = RES + ONE / EPS
                  KNT = KNT + 1
                  IF( RES.GT.RMAX ) THEN
                     LMAX = KNT
                     RMAX = RES
                  END IF
   10          CONTINUE
   20       CONTINUE
   30    CONTINUE
   40 CONTINUE
*
      DO 110 IA = 1, 5
         DO 100 IAM = 1, 2
            DO 90 IB = 1, 5
               DO 80 IC11 = 1, 5
                  DO 70 IC12 = 2, 5
                     DO 60 IC21 = 2, 4
                        DO 50 IC22 = -1, 1, 2
                           T( 1, 1 ) = VAL( IA )*VM( IAM )
                           T( 1, 2 ) = VAL( IB )
                           T( 1, 3 ) = -TWO*VAL( IB )
                           T( 2, 1 ) = ZERO
                           T( 2, 2 ) = VAL( IC11 )
                           T( 2, 3 ) = VAL( IC12 )
                           T( 3, 1 ) = ZERO
                           T( 3, 2 ) = -VAL( IC21 )
                           T( 3, 3 ) = VAL( IC11 )*REAL( IC22 )
                           TNRM = MAX( ABS( T( 1, 1 ) ),
     $                            ABS( T( 1, 2 ) ), ABS( T( 1, 3 ) ),
     $                            ABS( T( 2, 2 ) ), ABS( T( 2, 3 ) ),
     $                            ABS( T( 3, 2 ) ), ABS( T( 3, 3 ) ) )
                           CALL SCOPY( 16, T, 1, T1, 1 )
                           CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
                           CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
                           CALL SLAEXC( .TRUE., 3, T, 4, Q, 4, 1, 1, 2,
     $                                  WORK, INFO )
                           IF( INFO.NE.0 )
     $                        NINFO( INFO ) = NINFO( INFO ) + 1
                           CALL SHST01( 3, 1, 3, T1, 4, T, 4, Q, 4,
     $                                  WORK, LWORK, RESULT )
                           RES = RESULT( 1 ) + RESULT( 2 )
                           IF( INFO.EQ.0 ) THEN
                              IF( T1( 1, 1 ).NE.T( 3, 3 ) )
     $                           RES = RES + ONE / EPS
                              IF( T( 3, 1 ).NE.ZERO )
     $                           RES = RES + ONE / EPS
                              IF( T( 3, 2 ).NE.ZERO )
     $                           RES = RES + ONE / EPS
                              IF( T( 2, 1 ).NE.0 .AND.
     $                            ( T( 1, 1 ).NE.T( 2,
     $                            2 ) .OR. SIGN( ONE, T( 1,
     $                            2 ) ).EQ.SIGN( ONE, T( 2, 1 ) ) ) )
     $                            RES = RES + ONE / EPS
                           END IF
                           KNT = KNT + 1
                           IF( RES.GT.RMAX ) THEN
                              LMAX = KNT
                              RMAX = RES
                           END IF
   50                   CONTINUE
   60                CONTINUE
   70             CONTINUE
   80          CONTINUE
   90       CONTINUE
  100    CONTINUE
  110 CONTINUE
*
      DO 180 IA11 = 1, 5
         DO 170 IA12 = 2, 5
            DO 160 IA21 = 2, 4
               DO 150 IA22 = -1, 1, 2
                  DO 140 ICM = 1, 2
                     DO 130 IB = 1, 5
                        DO 120 IC = 1, 5
                           T( 1, 1 ) = VAL( IA11 )
                           T( 1, 2 ) = VAL( IA12 )
                           T( 1, 3 ) = -TWO*VAL( IB )
                           T( 2, 1 ) = -VAL( IA21 )
                           T( 2, 2 ) = VAL( IA11 )*REAL( IA22 )
                           T( 2, 3 ) = VAL( IB )
                           T( 3, 1 ) = ZERO
                           T( 3, 2 ) = ZERO
                           T( 3, 3 ) = VAL( IC )*VM( ICM )
                           TNRM = MAX( ABS( T( 1, 1 ) ),
     $                            ABS( T( 1, 2 ) ), ABS( T( 1, 3 ) ),
     $                            ABS( T( 2, 2 ) ), ABS( T( 2, 3 ) ),
     $                            ABS( T( 3, 2 ) ), ABS( T( 3, 3 ) ) )
                           CALL SCOPY( 16, T, 1, T1, 1 )
                           CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
                           CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
                           CALL SLAEXC( .TRUE., 3, T, 4, Q, 4, 1, 2, 1,
     $                                  WORK, INFO )
                           IF( INFO.NE.0 )
     $                        NINFO( INFO ) = NINFO( INFO ) + 1
                           CALL SHST01( 3, 1, 3, T1, 4, T, 4, Q, 4,
     $                                  WORK, LWORK, RESULT )
                           RES = RESULT( 1 ) + RESULT( 2 )
                           IF( INFO.EQ.0 ) THEN
                              IF( T1( 3, 3 ).NE.T( 1, 1 ) )
     $                           RES = RES + ONE / EPS
                              IF( T( 2, 1 ).NE.ZERO )
     $                           RES = RES + ONE / EPS
                              IF( T( 3, 1 ).NE.ZERO )
     $                           RES = RES + ONE / EPS
                              IF( T( 3, 2 ).NE.0 .AND.
     $                            ( T( 2, 2 ).NE.T( 3,
     $                            3 ) .OR. SIGN( ONE, T( 2,
     $                            3 ) ).EQ.SIGN( ONE, T( 3, 2 ) ) ) )
     $                            RES = RES + ONE / EPS
                           END IF
                           KNT = KNT + 1
                           IF( RES.GT.RMAX ) THEN
                              LMAX = KNT
                              RMAX = RES
                           END IF
  120                   CONTINUE
  130                CONTINUE
  140             CONTINUE
  150          CONTINUE
  160       CONTINUE
  170    CONTINUE
  180 CONTINUE
*
      DO 300 IA11 = 1, 5
         DO 290 IA12 = 2, 5
            DO 280 IA21 = 2, 4
               DO 270 IA22 = -1, 1, 2
                  DO 260 IB = 1, 5
                     DO 250 IC11 = 3, 4
                        DO 240 IC12 = 3, 4
                           DO 230 IC21 = 3, 4
                              DO 220 IC22 = -1, 1, 2
                                 DO 210 ICM = 5, 7
                                    IAM = 1
                                    T( 1, 1 ) = VAL( IA11 )*VM( IAM )
                                    T( 1, 2 ) = VAL( IA12 )*VM( IAM )
                                    T( 1, 3 ) = -TWO*VAL( IB )
                                    T( 1, 4 ) = HALF*VAL( IB )
                                    T( 2, 1 ) = -T( 1, 2 )*VAL( IA21 )
                                    T( 2, 2 ) = VAL( IA11 )*
     $                                          REAL( IA22 )*VM( IAM )
                                    T( 2, 3 ) = VAL( IB )
                                    T( 2, 4 ) = THREE*VAL( IB )
                                    T( 3, 1 ) = ZERO
                                    T( 3, 2 ) = ZERO
                                    T( 3, 3 ) = VAL( IC11 )*
     $                                          ABS( VAL( ICM ) )
                                    T( 3, 4 ) = VAL( IC12 )*
     $                                          ABS( VAL( ICM ) )
                                    T( 4, 1 ) = ZERO
                                    T( 4, 2 ) = ZERO
                                    T( 4, 3 ) = -T( 3, 4 )*VAL( IC21 )*
     $                                          ABS( VAL( ICM ) )
                                    T( 4, 4 ) = VAL( IC11 )*
     $                                          REAL( IC22 )*
     $                                          ABS( VAL( ICM ) )
                                    TNRM = ZERO
                                    DO 200 I = 1, 4
                                       DO 190 J = 1, 4
                                          TNRM = MAX( TNRM,
     $                                           ABS( T( I, J ) ) )
  190                                  CONTINUE
  200                               CONTINUE
                                    CALL SCOPY( 16, T, 1, T1, 1 )
                                    CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
                                    CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
                                    CALL SLAEXC( .TRUE., 4, T, 4, Q, 4,
     $                                           1, 2, 2, WORK, INFO )
                                    IF( INFO.NE.0 )
     $                                 NINFO( INFO ) = NINFO( INFO ) + 1
                                    CALL SHST01( 4, 1, 4, T1, 4, T, 4,
     $                                           Q, 4, WORK, LWORK,
     $                                           RESULT )
                                    RES = RESULT( 1 ) + RESULT( 2 )
                                    IF( INFO.EQ.0 ) THEN
                                       IF( T( 3, 1 ).NE.ZERO )
     $                                    RES = RES + ONE / EPS
                                       IF( T( 4, 1 ).NE.ZERO )
     $                                    RES = RES + ONE / EPS
                                       IF( T( 3, 2 ).NE.ZERO )
     $                                    RES = RES + ONE / EPS
                                       IF( T( 4, 2 ).NE.ZERO )
     $                                    RES = RES + ONE / EPS
                                       IF( T( 2, 1 ).NE.0 .AND.
     $                                     ( T( 1, 1 ).NE.T( 2,
     $                                     2 ) .OR. SIGN( ONE, T( 1,
     $                                     2 ) ).EQ.SIGN( ONE, T( 2,
     $                                     1 ) ) ) )RES = RES +
     $                                     ONE / EPS
                                       IF( T( 4, 3 ).NE.0 .AND.
     $                                     ( T( 3, 3 ).NE.T( 4,
     $                                     4 ) .OR. SIGN( ONE, T( 3,
     $                                     4 ) ).EQ.SIGN( ONE, T( 4,
     $                                     3 ) ) ) )RES = RES +
     $                                     ONE / EPS
                                    END IF
                                    KNT = KNT + 1
                                    IF( RES.GT.RMAX ) THEN
                                       LMAX = KNT
                                       RMAX = RES
                                    END IF
  210                            CONTINUE
  220                         CONTINUE
  230                      CONTINUE
  240                   CONTINUE
  250                CONTINUE
  260             CONTINUE
  270          CONTINUE
  280       CONTINUE
  290    CONTINUE
  300 CONTINUE
*
      RETURN
*
*     End of SGET34
*
      END