LAPACK: TESTING/EIG/dget33.f Source File

Go to the documentation of this file.
00001       SUBROUTINE DGET33( 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, NINFO
00009       DOUBLE PRECISION   RMAX
00010 *     ..
00011 *
00012 *  Purpose
00013 *  =======
00014 *
00015 *  DGET33 tests DLANV2, a routine for putting 2 by 2 blocks into
00016 *  standard form.  In other words, it computes a two by two rotation
00017 *  [[C,S];[-S,C]] where in
00018 *
00019 *     [ C S ][T(1,1) T(1,2)][ C -S ] = [ T11 T12 ]
00020 *     [-S C ][T(2,1) T(2,2)][ S  C ]   [ T21 T22 ]
00021 *
00022 *  either
00023 *     1) T21=0 (real eigenvalues), or
00024 *     2) T11=T22 and T21*T12<0 (complex conjugate eigenvalues).
00025 *  We also  verify that the residual is small.
00026 *
00027 *  Arguments
00028 *  ==========
00029 *
00030 *  RMAX    (output) DOUBLE PRECISION
00031 *          Value of the largest test ratio.
00032 *
00033 *  LMAX    (output) INTEGER
00034 *          Example number where largest test ratio achieved.
00035 *
00036 *  NINFO   (output) INTEGER
00037 *          Number of examples returned with INFO .NE. 0.
00038 *
00039 *  KNT     (output) INTEGER
00040 *          Total number of examples tested.
00041 *
00042 *  =====================================================================
00043 *
00044 *     .. Parameters ..
00045       DOUBLE PRECISION   ZERO, ONE
00046       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
00047       DOUBLE PRECISION   TWO, FOUR
00048       PARAMETER          ( TWO = 2.0D0, FOUR = 4.0D0 )
00049 *     ..
00050 *     .. Local Scalars ..
00051       INTEGER            I1, I2, I3, I4, IM1, IM2, IM3, IM4, J1, J2, J3
00052       DOUBLE PRECISION   BIGNUM, CS, EPS, RES, SMLNUM, SN, SUM, TNRM,
00053      $                   WI1, WI2, WR1, WR2
00054 *     ..
00055 *     .. Local Arrays ..
00056       DOUBLE PRECISION   Q( 2, 2 ), T( 2, 2 ), T1( 2, 2 ), T2( 2, 2 ),
00057      $                   VAL( 4 ), VM( 3 )
00058 *     ..
00059 *     .. External Functions ..
00060       DOUBLE PRECISION   DLAMCH
00061       EXTERNAL           DLAMCH
00062 *     ..
00063 *     .. External Subroutines ..
00064       EXTERNAL           DLABAD, DLANV2
00065 *     ..
00066 *     .. Intrinsic Functions ..
00067       INTRINSIC          ABS, MAX, SIGN
00068 *     ..
00069 *     .. Executable Statements ..
00070 *
00071 *     Get machine parameters
00072 *
00073       EPS = DLAMCH( 'P' )
00074       SMLNUM = DLAMCH( 'S' ) / EPS
00075       BIGNUM = ONE / SMLNUM
00076       CALL DLABAD( SMLNUM, BIGNUM )
00077 *
00078 *     Set up test case parameters
00079 *
00080       VAL( 1 ) = ONE
00081       VAL( 2 ) = ONE + TWO*EPS
00082       VAL( 3 ) = TWO
00083       VAL( 4 ) = TWO - FOUR*EPS
00084       VM( 1 ) = SMLNUM
00085       VM( 2 ) = ONE
00086       VM( 3 ) = BIGNUM
00087 *
00088       KNT = 0
00089       NINFO = 0
00090       LMAX = 0
00091       RMAX = ZERO
00092 *
00093 *     Begin test loop
00094 *
00095       DO 150 I1 = 1, 4
00096          DO 140 I2 = 1, 4
00097             DO 130 I3 = 1, 4
00098                DO 120 I4 = 1, 4
00099                   DO 110 IM1 = 1, 3
00100                      DO 100 IM2 = 1, 3
00101                         DO 90 IM3 = 1, 3
00102                            DO 80 IM4 = 1, 3
00103                               T( 1, 1 ) = VAL( I1 )*VM( IM1 )
00104                               T( 1, 2 ) = VAL( I2 )*VM( IM2 )
00105                               T( 2, 1 ) = -VAL( I3 )*VM( IM3 )
00106                               T( 2, 2 ) = VAL( I4 )*VM( IM4 )
00107                               TNRM = MAX( ABS( T( 1, 1 ) ),
00108      $                               ABS( T( 1, 2 ) ), ABS( T( 2, 1 ) ),
00109      $                               ABS( T( 2, 2 ) ) )
00110                               T1( 1, 1 ) = T( 1, 1 )
00111                               T1( 1, 2 ) = T( 1, 2 )
00112                               T1( 2, 1 ) = T( 2, 1 )
00113                               T1( 2, 2 ) = T( 2, 2 )
00114                               Q( 1, 1 ) = ONE
00115                               Q( 1, 2 ) = ZERO
00116                               Q( 2, 1 ) = ZERO
00117                               Q( 2, 2 ) = ONE
00118 *
00119                               CALL DLANV2( T( 1, 1 ), T( 1, 2 ),
00120      $                                     T( 2, 1 ), T( 2, 2 ), WR1,
00121      $                                     WI1, WR2, WI2, CS, SN )
00122                               DO 10 J1 = 1, 2
00123                                  RES = Q( J1, 1 )*CS + Q( J1, 2 )*SN
00124                                  Q( J1, 2 ) = -Q( J1, 1 )*SN +
00125      $                                        Q( J1, 2 )*CS
00126                                  Q( J1, 1 ) = RES
00127    10                         CONTINUE
00128 *
00129                               RES = ZERO
00130                               RES = RES + ABS( Q( 1, 1 )**2+
00131      $                              Q( 1, 2 )**2-ONE ) / EPS
00132                               RES = RES + ABS( Q( 2, 2 )**2+
00133      $                              Q( 2, 1 )**2-ONE ) / EPS
00134                               RES = RES + ABS( Q( 1, 1 )*Q( 2, 1 )+
00135      $                              Q( 1, 2 )*Q( 2, 2 ) ) / EPS
00136                               DO 40 J1 = 1, 2
00137                                  DO 30 J2 = 1, 2
00138                                     T2( J1, J2 ) = ZERO
00139                                     DO 20 J3 = 1, 2
00140                                        T2( J1, J2 ) = T2( J1, J2 ) +
00141      $                                                T1( J1, J3 )*
00142      $                                                Q( J3, J2 )
00143    20                               CONTINUE
00144    30                            CONTINUE
00145    40                         CONTINUE
00146                               DO 70 J1 = 1, 2
00147                                  DO 60 J2 = 1, 2
00148                                     SUM = T( J1, J2 )
00149                                     DO 50 J3 = 1, 2
00150                                        SUM = SUM - Q( J3, J1 )*
00151      $                                       T2( J3, J2 )
00152    50                               CONTINUE
00153                                     RES = RES + ABS( SUM ) / EPS / TNRM
00154    60                            CONTINUE
00155    70                         CONTINUE
00156                               IF( T( 2, 1 ).NE.ZERO .AND.
00157      $                            ( T( 1, 1 ).NE.T( 2,
00158      $                            2 ) .OR. SIGN( ONE, T( 1,
00159      $                            2 ) )*SIGN( ONE, T( 2,
00160      $                            1 ) ).GT.ZERO ) )RES = RES + ONE / EPS
00161                               KNT = KNT + 1
00162                               IF( RES.GT.RMAX ) THEN
00163                                  LMAX = KNT
00164                                  RMAX = RES
00165                               END IF
00166    80                      CONTINUE
00167    90                   CONTINUE
00168   100                CONTINUE
00169   110             CONTINUE
00170   120          CONTINUE
00171   130       CONTINUE
00172   140    CONTINUE
00173   150 CONTINUE
00174 *
00175       RETURN
00176 *
00177 *     End of DGET33
00178 *
00179       END