LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sget34.f
Go to the documentation of this file.
00001 *> \brief \b SGET34
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE SGET34( RMAX, LMAX, NINFO, KNT )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            KNT, LMAX
00015 *       REAL               RMAX
00016 *       ..
00017 *       .. Array Arguments ..
00018 *       INTEGER            NINFO( 2 )
00019 *       ..
00020 *  
00021 *
00022 *> \par Purpose:
00023 *  =============
00024 *>
00025 *> \verbatim
00026 *>
00027 *> SGET34 tests SLAEXC, a routine for swapping adjacent blocks (either
00028 *> 1 by 1 or 2 by 2) on the diagonal of a matrix in real Schur form.
00029 *> Thus, SLAEXC computes an orthogonal matrix Q such that
00030 *>
00031 *>     Q' * [ A B ] * Q  = [ C1 B1 ]
00032 *>          [ 0 C ]        [ 0  A1 ]
00033 *>
00034 *> where C1 is similar to C and A1 is similar to A.  Both A and C are
00035 *> assumed to be in standard form (equal diagonal entries and
00036 *> offdiagonal with differing signs) and A1 and C1 are returned with the
00037 *> same properties.
00038 *>
00039 *> The test code verifies these last last assertions, as well as that
00040 *> the residual in the above equation is small.
00041 *> \endverbatim
00042 *
00043 *  Arguments:
00044 *  ==========
00045 *
00046 *> \param[out] RMAX
00047 *> \verbatim
00048 *>          RMAX is REAL
00049 *>          Value of the largest test ratio.
00050 *> \endverbatim
00051 *>
00052 *> \param[out] LMAX
00053 *> \verbatim
00054 *>          LMAX is INTEGER
00055 *>          Example number where largest test ratio achieved.
00056 *> \endverbatim
00057 *>
00058 *> \param[out] NINFO
00059 *> \verbatim
00060 *>          NINFO is INTEGER array, dimension (2)
00061 *>          NINFO(J) is the number of examples where INFO=J occurred.
00062 *> \endverbatim
00063 *>
00064 *> \param[out] KNT
00065 *> \verbatim
00066 *>          KNT is INTEGER
00067 *>          Total number of examples tested.
00068 *> \endverbatim
00069 *
00070 *  Authors:
00071 *  ========
00072 *
00073 *> \author Univ. of Tennessee 
00074 *> \author Univ. of California Berkeley 
00075 *> \author Univ. of Colorado Denver 
00076 *> \author NAG Ltd. 
00077 *
00078 *> \date November 2011
00079 *
00080 *> \ingroup single_eig
00081 *
00082 *  =====================================================================
00083       SUBROUTINE SGET34( RMAX, LMAX, NINFO, KNT )
00084 *
00085 *  -- LAPACK test routine (version 3.4.0) --
00086 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00087 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00088 *     November 2011
00089 *
00090 *     .. Scalar Arguments ..
00091       INTEGER            KNT, LMAX
00092       REAL               RMAX
00093 *     ..
00094 *     .. Array Arguments ..
00095       INTEGER            NINFO( 2 )
00096 *     ..
00097 *
00098 *  =====================================================================
00099 *
00100 *     .. Parameters ..
00101       REAL               ZERO, HALF, ONE
00102       PARAMETER          ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0 )
00103       REAL               TWO, THREE
00104       PARAMETER          ( TWO = 2.0E0, THREE = 3.0E0 )
00105       INTEGER            LWORK
00106       PARAMETER          ( LWORK = 32 )
00107 *     ..
00108 *     .. Local Scalars ..
00109       INTEGER            I, IA, IA11, IA12, IA21, IA22, IAM, IB, IC,
00110      $                   IC11, IC12, IC21, IC22, ICM, INFO, J
00111       REAL               BIGNUM, EPS, RES, SMLNUM, TNRM
00112 *     ..
00113 *     .. Local Arrays ..
00114       REAL               Q( 4, 4 ), RESULT( 2 ), T( 4, 4 ), T1( 4, 4 ),
00115      $                   VAL( 9 ), VM( 2 ), WORK( LWORK )
00116 *     ..
00117 *     .. External Functions ..
00118       REAL               SLAMCH
00119       EXTERNAL           SLAMCH
00120 *     ..
00121 *     .. External Subroutines ..
00122       EXTERNAL           SCOPY, SLAEXC
00123 *     ..
00124 *     .. Intrinsic Functions ..
00125       INTRINSIC          ABS, MAX, REAL, SIGN, SQRT
00126 *     ..
00127 *     .. Executable Statements ..
00128 *
00129 *     Get machine parameters
00130 *
00131       EPS = SLAMCH( 'P' )
00132       SMLNUM = SLAMCH( 'S' ) / EPS
00133       BIGNUM = ONE / SMLNUM
00134       CALL SLABAD( SMLNUM, BIGNUM )
00135 *
00136 *     Set up test case parameters
00137 *
00138       VAL( 1 ) = ZERO
00139       VAL( 2 ) = SQRT( SMLNUM )
00140       VAL( 3 ) = ONE
00141       VAL( 4 ) = TWO
00142       VAL( 5 ) = SQRT( BIGNUM )
00143       VAL( 6 ) = -SQRT( SMLNUM )
00144       VAL( 7 ) = -ONE
00145       VAL( 8 ) = -TWO
00146       VAL( 9 ) = -SQRT( BIGNUM )
00147       VM( 1 ) = ONE
00148       VM( 2 ) = ONE + TWO*EPS
00149       CALL SCOPY( 16, VAL( 4 ), 0, T( 1, 1 ), 1 )
00150 *
00151       NINFO( 1 ) = 0
00152       NINFO( 2 ) = 0
00153       KNT = 0
00154       LMAX = 0
00155       RMAX = ZERO
00156 *
00157 *     Begin test loop
00158 *
00159       DO 40 IA = 1, 9
00160          DO 30 IAM = 1, 2
00161             DO 20 IB = 1, 9
00162                DO 10 IC = 1, 9
00163                   T( 1, 1 ) = VAL( IA )*VM( IAM )
00164                   T( 2, 2 ) = VAL( IC )
00165                   T( 1, 2 ) = VAL( IB )
00166                   T( 2, 1 ) = ZERO
00167                   TNRM = MAX( ABS( T( 1, 1 ) ), ABS( T( 2, 2 ) ),
00168      $                   ABS( T( 1, 2 ) ) )
00169                   CALL SCOPY( 16, T, 1, T1, 1 )
00170                   CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
00171                   CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
00172                   CALL SLAEXC( .TRUE., 2, T, 4, Q, 4, 1, 1, 1, WORK,
00173      $                         INFO )
00174                   IF( INFO.NE.0 )
00175      $               NINFO( INFO ) = NINFO( INFO ) + 1
00176                   CALL SHST01( 2, 1, 2, T1, 4, T, 4, Q, 4, WORK, LWORK,
00177      $                         RESULT )
00178                   RES = RESULT( 1 ) + RESULT( 2 )
00179                   IF( INFO.NE.0 )
00180      $               RES = RES + ONE / EPS
00181                   IF( T( 1, 1 ).NE.T1( 2, 2 ) )
00182      $               RES = RES + ONE / EPS
00183                   IF( T( 2, 2 ).NE.T1( 1, 1 ) )
00184      $               RES = RES + ONE / EPS
00185                   IF( T( 2, 1 ).NE.ZERO )
00186      $               RES = RES + ONE / EPS
00187                   KNT = KNT + 1
00188                   IF( RES.GT.RMAX ) THEN
00189                      LMAX = KNT
00190                      RMAX = RES
00191                   END IF
00192    10          CONTINUE
00193    20       CONTINUE
00194    30    CONTINUE
00195    40 CONTINUE
00196 *
00197       DO 110 IA = 1, 5
00198          DO 100 IAM = 1, 2
00199             DO 90 IB = 1, 5
00200                DO 80 IC11 = 1, 5
00201                   DO 70 IC12 = 2, 5
00202                      DO 60 IC21 = 2, 4
00203                         DO 50 IC22 = -1, 1, 2
00204                            T( 1, 1 ) = VAL( IA )*VM( IAM )
00205                            T( 1, 2 ) = VAL( IB )
00206                            T( 1, 3 ) = -TWO*VAL( IB )
00207                            T( 2, 1 ) = ZERO
00208                            T( 2, 2 ) = VAL( IC11 )
00209                            T( 2, 3 ) = VAL( IC12 )
00210                            T( 3, 1 ) = ZERO
00211                            T( 3, 2 ) = -VAL( IC21 )
00212                            T( 3, 3 ) = VAL( IC11 )*REAL( IC22 )
00213                            TNRM = MAX( ABS( T( 1, 1 ) ),
00214      $                            ABS( T( 1, 2 ) ), ABS( T( 1, 3 ) ),
00215      $                            ABS( T( 2, 2 ) ), ABS( T( 2, 3 ) ),
00216      $                            ABS( T( 3, 2 ) ), ABS( T( 3, 3 ) ) )
00217                            CALL SCOPY( 16, T, 1, T1, 1 )
00218                            CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
00219                            CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
00220                            CALL SLAEXC( .TRUE., 3, T, 4, Q, 4, 1, 1, 2,
00221      $                                  WORK, INFO )
00222                            IF( INFO.NE.0 )
00223      $                        NINFO( INFO ) = NINFO( INFO ) + 1
00224                            CALL SHST01( 3, 1, 3, T1, 4, T, 4, Q, 4,
00225      $                                  WORK, LWORK, RESULT )
00226                            RES = RESULT( 1 ) + RESULT( 2 )
00227                            IF( INFO.EQ.0 ) THEN
00228                               IF( T1( 1, 1 ).NE.T( 3, 3 ) )
00229      $                           RES = RES + ONE / EPS
00230                               IF( T( 3, 1 ).NE.ZERO )
00231      $                           RES = RES + ONE / EPS
00232                               IF( T( 3, 2 ).NE.ZERO )
00233      $                           RES = RES + ONE / EPS
00234                               IF( T( 2, 1 ).NE.0 .AND.
00235      $                            ( T( 1, 1 ).NE.T( 2,
00236      $                            2 ) .OR. SIGN( ONE, T( 1,
00237      $                            2 ) ).EQ.SIGN( ONE, T( 2, 1 ) ) ) )
00238      $                            RES = RES + ONE / EPS
00239                            END IF
00240                            KNT = KNT + 1
00241                            IF( RES.GT.RMAX ) THEN
00242                               LMAX = KNT
00243                               RMAX = RES
00244                            END IF
00245    50                   CONTINUE
00246    60                CONTINUE
00247    70             CONTINUE
00248    80          CONTINUE
00249    90       CONTINUE
00250   100    CONTINUE
00251   110 CONTINUE
00252 *
00253       DO 180 IA11 = 1, 5
00254          DO 170 IA12 = 2, 5
00255             DO 160 IA21 = 2, 4
00256                DO 150 IA22 = -1, 1, 2
00257                   DO 140 ICM = 1, 2
00258                      DO 130 IB = 1, 5
00259                         DO 120 IC = 1, 5
00260                            T( 1, 1 ) = VAL( IA11 )
00261                            T( 1, 2 ) = VAL( IA12 )
00262                            T( 1, 3 ) = -TWO*VAL( IB )
00263                            T( 2, 1 ) = -VAL( IA21 )
00264                            T( 2, 2 ) = VAL( IA11 )*REAL( IA22 )
00265                            T( 2, 3 ) = VAL( IB )
00266                            T( 3, 1 ) = ZERO
00267                            T( 3, 2 ) = ZERO
00268                            T( 3, 3 ) = VAL( IC )*VM( ICM )
00269                            TNRM = MAX( ABS( T( 1, 1 ) ),
00270      $                            ABS( T( 1, 2 ) ), ABS( T( 1, 3 ) ),
00271      $                            ABS( T( 2, 2 ) ), ABS( T( 2, 3 ) ),
00272      $                            ABS( T( 3, 2 ) ), ABS( T( 3, 3 ) ) )
00273                            CALL SCOPY( 16, T, 1, T1, 1 )
00274                            CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
00275                            CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
00276                            CALL SLAEXC( .TRUE., 3, T, 4, Q, 4, 1, 2, 1,
00277      $                                  WORK, INFO )
00278                            IF( INFO.NE.0 )
00279      $                        NINFO( INFO ) = NINFO( INFO ) + 1
00280                            CALL SHST01( 3, 1, 3, T1, 4, T, 4, Q, 4,
00281      $                                  WORK, LWORK, RESULT )
00282                            RES = RESULT( 1 ) + RESULT( 2 )
00283                            IF( INFO.EQ.0 ) THEN
00284                               IF( T1( 3, 3 ).NE.T( 1, 1 ) )
00285      $                           RES = RES + ONE / EPS
00286                               IF( T( 2, 1 ).NE.ZERO )
00287      $                           RES = RES + ONE / EPS
00288                               IF( T( 3, 1 ).NE.ZERO )
00289      $                           RES = RES + ONE / EPS
00290                               IF( T( 3, 2 ).NE.0 .AND.
00291      $                            ( T( 2, 2 ).NE.T( 3,
00292      $                            3 ) .OR. SIGN( ONE, T( 2,
00293      $                            3 ) ).EQ.SIGN( ONE, T( 3, 2 ) ) ) )
00294      $                            RES = RES + ONE / EPS
00295                            END IF
00296                            KNT = KNT + 1
00297                            IF( RES.GT.RMAX ) THEN
00298                               LMAX = KNT
00299                               RMAX = RES
00300                            END IF
00301   120                   CONTINUE
00302   130                CONTINUE
00303   140             CONTINUE
00304   150          CONTINUE
00305   160       CONTINUE
00306   170    CONTINUE
00307   180 CONTINUE
00308 *
00309       DO 300 IA11 = 1, 5
00310          DO 290 IA12 = 2, 5
00311             DO 280 IA21 = 2, 4
00312                DO 270 IA22 = -1, 1, 2
00313                   DO 260 IB = 1, 5
00314                      DO 250 IC11 = 3, 4
00315                         DO 240 IC12 = 3, 4
00316                            DO 230 IC21 = 3, 4
00317                               DO 220 IC22 = -1, 1, 2
00318                                  DO 210 ICM = 5, 7
00319                                     IAM = 1
00320                                     T( 1, 1 ) = VAL( IA11 )*VM( IAM )
00321                                     T( 1, 2 ) = VAL( IA12 )*VM( IAM )
00322                                     T( 1, 3 ) = -TWO*VAL( IB )
00323                                     T( 1, 4 ) = HALF*VAL( IB )
00324                                     T( 2, 1 ) = -T( 1, 2 )*VAL( IA21 )
00325                                     T( 2, 2 ) = VAL( IA11 )*
00326      $                                          REAL( IA22 )*VM( IAM )
00327                                     T( 2, 3 ) = VAL( IB )
00328                                     T( 2, 4 ) = THREE*VAL( IB )
00329                                     T( 3, 1 ) = ZERO
00330                                     T( 3, 2 ) = ZERO
00331                                     T( 3, 3 ) = VAL( IC11 )*
00332      $                                          ABS( VAL( ICM ) )
00333                                     T( 3, 4 ) = VAL( IC12 )*
00334      $                                          ABS( VAL( ICM ) )
00335                                     T( 4, 1 ) = ZERO
00336                                     T( 4, 2 ) = ZERO
00337                                     T( 4, 3 ) = -T( 3, 4 )*VAL( IC21 )*
00338      $                                          ABS( VAL( ICM ) )
00339                                     T( 4, 4 ) = VAL( IC11 )*
00340      $                                          REAL( IC22 )*
00341      $                                          ABS( VAL( ICM ) )
00342                                     TNRM = ZERO
00343                                     DO 200 I = 1, 4
00344                                        DO 190 J = 1, 4
00345                                           TNRM = MAX( TNRM,
00346      $                                           ABS( T( I, J ) ) )
00347   190                                  CONTINUE
00348   200                               CONTINUE
00349                                     CALL SCOPY( 16, T, 1, T1, 1 )
00350                                     CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
00351                                     CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
00352                                     CALL SLAEXC( .TRUE., 4, T, 4, Q, 4,
00353      $                                           1, 2, 2, WORK, INFO )
00354                                     IF( INFO.NE.0 )
00355      $                                 NINFO( INFO ) = NINFO( INFO ) + 1
00356                                     CALL SHST01( 4, 1, 4, T1, 4, T, 4,
00357      $                                           Q, 4, WORK, LWORK,
00358      $                                           RESULT )
00359                                     RES = RESULT( 1 ) + RESULT( 2 )
00360                                     IF( INFO.EQ.0 ) THEN
00361                                        IF( T( 3, 1 ).NE.ZERO )
00362      $                                    RES = RES + ONE / EPS
00363                                        IF( T( 4, 1 ).NE.ZERO )
00364      $                                    RES = RES + ONE / EPS
00365                                        IF( T( 3, 2 ).NE.ZERO )
00366      $                                    RES = RES + ONE / EPS
00367                                        IF( T( 4, 2 ).NE.ZERO )
00368      $                                    RES = RES + ONE / EPS
00369                                        IF( T( 2, 1 ).NE.0 .AND.
00370      $                                     ( T( 1, 1 ).NE.T( 2,
00371      $                                     2 ) .OR. SIGN( ONE, T( 1,
00372      $                                     2 ) ).EQ.SIGN( ONE, T( 2,
00373      $                                     1 ) ) ) )RES = RES +
00374      $                                     ONE / EPS
00375                                        IF( T( 4, 3 ).NE.0 .AND.
00376      $                                     ( T( 3, 3 ).NE.T( 4,
00377      $                                     4 ) .OR. SIGN( ONE, T( 3,
00378      $                                     4 ) ).EQ.SIGN( ONE, T( 4,
00379      $                                     3 ) ) ) )RES = RES +
00380      $                                     ONE / EPS
00381                                     END IF
00382                                     KNT = KNT + 1
00383                                     IF( RES.GT.RMAX ) THEN
00384                                        LMAX = KNT
00385                                        RMAX = RES
00386                                     END IF
00387   210                            CONTINUE
00388   220                         CONTINUE
00389   230                      CONTINUE
00390   240                   CONTINUE
00391   250                CONTINUE
00392   260             CONTINUE
00393   270          CONTINUE
00394   280       CONTINUE
00395   290    CONTINUE
00396   300 CONTINUE
00397 *
00398       RETURN
00399 *
00400 *     End of SGET34
00401 *
00402       END
 All Files Functions