LAPACK: TESTING/EIG/dget34.f Source File

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