TESTING/EIG/sget34.f

   1 *> \brief \b SGET34
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE SGET34( RMAX, LMAX, NINFO, KNT )
  12 *
  13 *       .. Scalar Arguments ..
  14 *       INTEGER            KNT, LMAX
  15 *       REAL               RMAX
  16 *       ..
  17 *       .. Array Arguments ..
  18 *       INTEGER            NINFO( 2 )
  19 *       ..
  20 *
  21 *
  22 *> \par Purpose:
  23 *  =============
  24 *>
  25 *> \verbatim
  26 *>
  27 *> SGET34 tests SLAEXC, a routine for swapping adjacent blocks (either
  28 *> 1 by 1 or 2 by 2) on the diagonal of a matrix in real Schur form.
  29 *> Thus, SLAEXC computes an orthogonal matrix Q such that
  30 *>
  31 *>     Q' * [ A B ] * Q  = [ C1 B1 ]
  32 *>          [ 0 C ]        [ 0  A1 ]
  33 *>
  34 *> where C1 is similar to C and A1 is similar to A.  Both A and C are
  35 *> assumed to be in standard form (equal diagonal entries and
  36 *> offdiagonal with differing signs) and A1 and C1 are returned with the
  37 *> same properties.
  38 *>
  39 *> The test code verifies these last last assertions, as well as that
  40 *> the residual in the above equation is small.
  41 *> \endverbatim
  42 *
  43 *  Arguments:
  44 *  ==========
  45 *
  46 *> \param[out] RMAX
  47 *> \verbatim
  48 *>          RMAX is REAL
  49 *>          Value of the largest test ratio.
  50 *> \endverbatim
  51 *>
  52 *> \param[out] LMAX
  53 *> \verbatim
  54 *>          LMAX is INTEGER
  55 *>          Example number where largest test ratio achieved.
  56 *> \endverbatim
  57 *>
  58 *> \param[out] NINFO
  59 *> \verbatim
  60 *>          NINFO is INTEGER array, dimension (2)
  61 *>          NINFO(J) is the number of examples where INFO=J occurred.
  62 *> \endverbatim
  63 *>
  64 *> \param[out] KNT
  65 *> \verbatim
  66 *>          KNT is INTEGER
  67 *>          Total number of examples tested.
  68 *> \endverbatim
  69 *
  70 *  Authors:
  71 *  ========
  72 *
  73 *> \author Univ. of Tennessee
  74 *> \author Univ. of California Berkeley
  75 *> \author Univ. of Colorado Denver
  76 *> \author NAG Ltd.
  77 *
  78 *> \date November 2011
  79 *
  80 *> \ingroup single_eig
  81 *
  82 *  =====================================================================
  83       SUBROUTINE SGET34( RMAX, LMAX, NINFO, KNT )
  84 *
  85 *  -- LAPACK test routine (version 3.4.0) --
  86 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  87 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  88 *     November 2011
  89 *
  90 *     .. Scalar Arguments ..
  91       INTEGER            KNT, LMAX
  92       REAL               RMAX
  93 *     ..
  94 *     .. Array Arguments ..
  95       INTEGER            NINFO( 2 )
  96 *     ..
  97 *
  98 *  =====================================================================
  99 *
 100 *     .. Parameters ..
 101       REAL               ZERO, HALF, ONE
 102       PARAMETER          ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0 )
 103       REAL               TWO, THREE
 104       PARAMETER          ( TWO = 2.0E0, THREE = 3.0E0 )
 105       INTEGER            LWORK
 106       PARAMETER          ( LWORK = 32 )
 107 *     ..
 108 *     .. Local Scalars ..
 109       INTEGER            I, IA, IA11, IA12, IA21, IA22, IAM, IB, IC,
 110      $                   IC11, IC12, IC21, IC22, ICM, INFO, J
 111       REAL               BIGNUM, EPS, RES, SMLNUM, TNRM
 112 *     ..
 113 *     .. Local Arrays ..
 114       REAL               Q( 4, 4 ), RESULT( 2 ), T( 4, 4 ), T1( 4, 4 ),
 115      $                   VAL( 9 ), VM( 2 ), WORK( LWORK )
 116 *     ..
 117 *     .. External Functions ..
 118       REAL               SLAMCH
 119       EXTERNAL           SLAMCH
 120 *     ..
 121 *     .. External Subroutines ..
 122       EXTERNAL           SCOPY, SLAEXC
 123 *     ..
 124 *     .. Intrinsic Functions ..
 125       INTRINSIC          ABS, MAX, REAL, SIGN, SQRT
 126 *     ..
 127 *     .. Executable Statements ..
 128 *
 129 *     Get machine parameters
 130 *
 131       EPS = SLAMCH( 'P' )
 132       SMLNUM = SLAMCH( 'S' ) / EPS
 133       BIGNUM = ONE / SMLNUM
 134       CALL SLABAD( SMLNUM, BIGNUM )
 135 *
 136 *     Set up test case parameters
 137 *
 138       VAL( 1 ) = ZERO
 139       VAL( 2 ) = SQRT( SMLNUM )
 140       VAL( 3 ) = ONE
 141       VAL( 4 ) = TWO
 142       VAL( 5 ) = SQRT( BIGNUM )
 143       VAL( 6 ) = -SQRT( SMLNUM )
 144       VAL( 7 ) = -ONE
 145       VAL( 8 ) = -TWO
 146       VAL( 9 ) = -SQRT( BIGNUM )
 147       VM( 1 ) = ONE
 148       VM( 2 ) = ONE + TWO*EPS
 149       CALL SCOPY( 16, VAL( 4 ), 0, T( 1, 1 ), 1 )
 150 *
 151       NINFO( 1 ) = 0
 152       NINFO( 2 ) = 0
 153       KNT = 0
 154       LMAX = 0
 155       RMAX = ZERO
 156 *
 157 *     Begin test loop
 158 *
 159       DO 40 IA = 1, 9
 160          DO 30 IAM = 1, 2
 161             DO 20 IB = 1, 9
 162                DO 10 IC = 1, 9
 163                   T( 1, 1 ) = VAL( IA )*VM( IAM )
 164                   T( 2, 2 ) = VAL( IC )
 165                   T( 1, 2 ) = VAL( IB )
 166                   T( 2, 1 ) = ZERO
 167                   TNRM = MAX( ABS( T( 1, 1 ) ), ABS( T( 2, 2 ) ),
 168      $                   ABS( T( 1, 2 ) ) )
 169                   CALL SCOPY( 16, T, 1, T1, 1 )
 170                   CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
 171                   CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
 172                   CALL SLAEXC( .TRUE., 2, T, 4, Q, 4, 1, 1, 1, WORK,
 173      $                         INFO )
 174                   IF( INFO.NE.0 )
 175      $               NINFO( INFO ) = NINFO( INFO ) + 1
 176                   CALL SHST01( 2, 1, 2, T1, 4, T, 4, Q, 4, WORK, LWORK,
 177      $                         RESULT )
 178                   RES = RESULT( 1 ) + RESULT( 2 )
 179                   IF( INFO.NE.0 )
 180      $               RES = RES + ONE / EPS
 181                   IF( T( 1, 1 ).NE.T1( 2, 2 ) )
 182      $               RES = RES + ONE / EPS
 183                   IF( T( 2, 2 ).NE.T1( 1, 1 ) )
 184      $               RES = RES + ONE / EPS
 185                   IF( T( 2, 1 ).NE.ZERO )
 186      $               RES = RES + ONE / EPS
 187                   KNT = KNT + 1
 188                   IF( RES.GT.RMAX ) THEN
 189                      LMAX = KNT
 190                      RMAX = RES
 191                   END IF
 192    10          CONTINUE
 193    20       CONTINUE
 194    30    CONTINUE
 195    40 CONTINUE
 196 *
 197       DO 110 IA = 1, 5
 198          DO 100 IAM = 1, 2
 199             DO 90 IB = 1, 5
 200                DO 80 IC11 = 1, 5
 201                   DO 70 IC12 = 2, 5
 202                      DO 60 IC21 = 2, 4
 203                         DO 50 IC22 = -1, 1, 2
 204                            T( 1, 1 ) = VAL( IA )*VM( IAM )
 205                            T( 1, 2 ) = VAL( IB )
 206                            T( 1, 3 ) = -TWO*VAL( IB )
 207                            T( 2, 1 ) = ZERO
 208                            T( 2, 2 ) = VAL( IC11 )
 209                            T( 2, 3 ) = VAL( IC12 )
 210                            T( 3, 1 ) = ZERO
 211                            T( 3, 2 ) = -VAL( IC21 )
 212                            T( 3, 3 ) = VAL( IC11 )*REAL( IC22 )
 213                            TNRM = MAX( ABS( T( 1, 1 ) ),
 214      $                            ABS( T( 1, 2 ) ), ABS( T( 1, 3 ) ),
 215      $                            ABS( T( 2, 2 ) ), ABS( T( 2, 3 ) ),
 216      $                            ABS( T( 3, 2 ) ), ABS( T( 3, 3 ) ) )
 217                            CALL SCOPY( 16, T, 1, T1, 1 )
 218                            CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
 219                            CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
 220                            CALL SLAEXC( .TRUE., 3, T, 4, Q, 4, 1, 1, 2,
 221      $                                  WORK, INFO )
 222                            IF( INFO.NE.0 )
 223      $                        NINFO( INFO ) = NINFO( INFO ) + 1
 224                            CALL SHST01( 3, 1, 3, T1, 4, T, 4, Q, 4,
 225      $                                  WORK, LWORK, RESULT )
 226                            RES = RESULT( 1 ) + RESULT( 2 )
 227                            IF( INFO.EQ.0 ) THEN
 228                               IF( T1( 1, 1 ).NE.T( 3, 3 ) )
 229      $                           RES = RES + ONE / EPS
 230                               IF( T( 3, 1 ).NE.ZERO )
 231      $                           RES = RES + ONE / EPS
 232                               IF( T( 3, 2 ).NE.ZERO )
 233      $                           RES = RES + ONE / EPS
 234                               IF( T( 2, 1 ).NE.0 .AND.
 235      $                            ( T( 1, 1 ).NE.T( 2,
 236      $                            2 ) .OR. SIGN( ONE, T( 1,
 237      $                            2 ) ).EQ.SIGN( ONE, T( 2, 1 ) ) ) )
 238      $                            RES = RES + ONE / EPS
 239                            END IF
 240                            KNT = KNT + 1
 241                            IF( RES.GT.RMAX ) THEN
 242                               LMAX = KNT
 243                               RMAX = RES
 244                            END IF
 245    50                   CONTINUE
 246    60                CONTINUE
 247    70             CONTINUE
 248    80          CONTINUE
 249    90       CONTINUE
 250   100    CONTINUE
 251   110 CONTINUE
 252 *
 253       DO 180 IA11 = 1, 5
 254          DO 170 IA12 = 2, 5
 255             DO 160 IA21 = 2, 4
 256                DO 150 IA22 = -1, 1, 2
 257                   DO 140 ICM = 1, 2
 258                      DO 130 IB = 1, 5
 259                         DO 120 IC = 1, 5
 260                            T( 1, 1 ) = VAL( IA11 )
 261                            T( 1, 2 ) = VAL( IA12 )
 262                            T( 1, 3 ) = -TWO*VAL( IB )
 263                            T( 2, 1 ) = -VAL( IA21 )
 264                            T( 2, 2 ) = VAL( IA11 )*REAL( IA22 )
 265                            T( 2, 3 ) = VAL( IB )
 266                            T( 3, 1 ) = ZERO
 267                            T( 3, 2 ) = ZERO
 268                            T( 3, 3 ) = VAL( IC )*VM( ICM )
 269                            TNRM = MAX( ABS( T( 1, 1 ) ),
 270      $                            ABS( T( 1, 2 ) ), ABS( T( 1, 3 ) ),
 271      $                            ABS( T( 2, 2 ) ), ABS( T( 2, 3 ) ),
 272      $                            ABS( T( 3, 2 ) ), ABS( T( 3, 3 ) ) )
 273                            CALL SCOPY( 16, T, 1, T1, 1 )
 274                            CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
 275                            CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
 276                            CALL SLAEXC( .TRUE., 3, T, 4, Q, 4, 1, 2, 1,
 277      $                                  WORK, INFO )
 278                            IF( INFO.NE.0 )
 279      $                        NINFO( INFO ) = NINFO( INFO ) + 1
 280                            CALL SHST01( 3, 1, 3, T1, 4, T, 4, Q, 4,
 281      $                                  WORK, LWORK, RESULT )
 282                            RES = RESULT( 1 ) + RESULT( 2 )
 283                            IF( INFO.EQ.0 ) THEN
 284                               IF( T1( 3, 3 ).NE.T( 1, 1 ) )
 285      $                           RES = RES + ONE / EPS
 286                               IF( T( 2, 1 ).NE.ZERO )
 287      $                           RES = RES + ONE / EPS
 288                               IF( T( 3, 1 ).NE.ZERO )
 289      $                           RES = RES + ONE / EPS
 290                               IF( T( 3, 2 ).NE.0 .AND.
 291      $                            ( T( 2, 2 ).NE.T( 3,
 292      $                            3 ) .OR. SIGN( ONE, T( 2,
 293      $                            3 ) ).EQ.SIGN( ONE, T( 3, 2 ) ) ) )
 294      $                            RES = RES + ONE / EPS
 295                            END IF
 296                            KNT = KNT + 1
 297                            IF( RES.GT.RMAX ) THEN
 298                               LMAX = KNT
 299                               RMAX = RES
 300                            END IF
 301   120                   CONTINUE
 302   130                CONTINUE
 303   140             CONTINUE
 304   150          CONTINUE
 305   160       CONTINUE
 306   170    CONTINUE
 307   180 CONTINUE
 308 *
 309       DO 300 IA11 = 1, 5
 310          DO 290 IA12 = 2, 5
 311             DO 280 IA21 = 2, 4
 312                DO 270 IA22 = -1, 1, 2
 313                   DO 260 IB = 1, 5
 314                      DO 250 IC11 = 3, 4
 315                         DO 240 IC12 = 3, 4
 316                            DO 230 IC21 = 3, 4
 317                               DO 220 IC22 = -1, 1, 2
 318                                  DO 210 ICM = 5, 7
 319                                     IAM = 1
 320                                     T( 1, 1 ) = VAL( IA11 )*VM( IAM )
 321                                     T( 1, 2 ) = VAL( IA12 )*VM( IAM )
 322                                     T( 1, 3 ) = -TWO*VAL( IB )
 323                                     T( 1, 4 ) = HALF*VAL( IB )
 324                                     T( 2, 1 ) = -T( 1, 2 )*VAL( IA21 )
 325                                     T( 2, 2 ) = VAL( IA11 )*
 326      $                                          REAL( IA22 )*VM( IAM )
 327                                     T( 2, 3 ) = VAL( IB )
 328                                     T( 2, 4 ) = THREE*VAL( IB )
 329                                     T( 3, 1 ) = ZERO
 330                                     T( 3, 2 ) = ZERO
 331                                     T( 3, 3 ) = VAL( IC11 )*
 332      $                                          ABS( VAL( ICM ) )
 333                                     T( 3, 4 ) = VAL( IC12 )*
 334      $                                          ABS( VAL( ICM ) )
 335                                     T( 4, 1 ) = ZERO
 336                                     T( 4, 2 ) = ZERO
 337                                     T( 4, 3 ) = -T( 3, 4 )*VAL( IC21 )*
 338      $                                          ABS( VAL( ICM ) )
 339                                     T( 4, 4 ) = VAL( IC11 )*
 340      $                                          REAL( IC22 )*
 341      $                                          ABS( VAL( ICM ) )
 342                                     TNRM = ZERO
 343                                     DO 200 I = 1, 4
 344                                        DO 190 J = 1, 4
 345                                           TNRM = MAX( TNRM,
 346      $                                           ABS( T( I, J ) ) )
 347   190                                  CONTINUE
 348   200                               CONTINUE
 349                                     CALL SCOPY( 16, T, 1, T1, 1 )
 350                                     CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
 351                                     CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
 352                                     CALL SLAEXC( .TRUE., 4, T, 4, Q, 4,
 353      $                                           1, 2, 2, WORK, INFO )
 354                                     IF( INFO.NE.0 )
 355      $                                 NINFO( INFO ) = NINFO( INFO ) + 1
 356                                     CALL SHST01( 4, 1, 4, T1, 4, T, 4,
 357      $                                           Q, 4, WORK, LWORK,
 358      $                                           RESULT )
 359                                     RES = RESULT( 1 ) + RESULT( 2 )
 360                                     IF( INFO.EQ.0 ) THEN
 361                                        IF( T( 3, 1 ).NE.ZERO )
 362      $                                    RES = RES + ONE / EPS
 363                                        IF( T( 4, 1 ).NE.ZERO )
 364      $                                    RES = RES + ONE / EPS
 365                                        IF( T( 3, 2 ).NE.ZERO )
 366      $                                    RES = RES + ONE / EPS
 367                                        IF( T( 4, 2 ).NE.ZERO )
 368      $                                    RES = RES + ONE / EPS
 369                                        IF( T( 2, 1 ).NE.0 .AND.
 370      $                                     ( T( 1, 1 ).NE.T( 2,
 371      $                                     2 ) .OR. SIGN( ONE, T( 1,
 372      $                                     2 ) ).EQ.SIGN( ONE, T( 2,
 373      $                                     1 ) ) ) )RES = RES +
 374      $                                     ONE / EPS
 375                                        IF( T( 4, 3 ).NE.0 .AND.
 376      $                                     ( T( 3, 3 ).NE.T( 4,
 377      $                                     4 ) .OR. SIGN( ONE, T( 3,
 378      $                                     4 ) ).EQ.SIGN( ONE, T( 4,
 379      $                                     3 ) ) ) )RES = RES +
 380      $                                     ONE / EPS
 381                                     END IF
 382                                     KNT = KNT + 1
 383                                     IF( RES.GT.RMAX ) THEN
 384                                        LMAX = KNT
 385                                        RMAX = RES
 386                                     END IF
 387   210                            CONTINUE
 388   220                         CONTINUE
 389   230                      CONTINUE
 390   240                   CONTINUE
 391   250                CONTINUE
 392   260             CONTINUE
 393   270          CONTINUE
 394   280       CONTINUE
 395   290    CONTINUE
 396   300 CONTINUE
 397 *
 398       RETURN
 399 *
 400 *     End of SGET34
 401 *
 402       END