LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dget33.f
Go to the documentation of this file.
00001 *> \brief \b DGET33
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 DGET33( RMAX, LMAX, NINFO, KNT )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            KNT, LMAX, NINFO
00015 *       DOUBLE PRECISION   RMAX
00016 *       ..
00017 *  
00018 *
00019 *> \par Purpose:
00020 *  =============
00021 *>
00022 *> \verbatim
00023 *>
00024 *> DGET33 tests DLANV2, a routine for putting 2 by 2 blocks into
00025 *> standard form.  In other words, it computes a two by two rotation
00026 *> [[C,S];[-S,C]] where in
00027 *>
00028 *>    [ C S ][T(1,1) T(1,2)][ C -S ] = [ T11 T12 ]
00029 *>    [-S C ][T(2,1) T(2,2)][ S  C ]   [ T21 T22 ]
00030 *>
00031 *> either
00032 *>    1) T21=0 (real eigenvalues), or
00033 *>    2) T11=T22 and T21*T12<0 (complex conjugate eigenvalues).
00034 *> We also  verify that the residual is small.
00035 *> \endverbatim
00036 *
00037 *  Arguments:
00038 *  ==========
00039 *
00040 *> \param[out] RMAX
00041 *> \verbatim
00042 *>          RMAX is DOUBLE PRECISION
00043 *>          Value of the largest test ratio.
00044 *> \endverbatim
00045 *>
00046 *> \param[out] LMAX
00047 *> \verbatim
00048 *>          LMAX is INTEGER
00049 *>          Example number where largest test ratio achieved.
00050 *> \endverbatim
00051 *>
00052 *> \param[out] NINFO
00053 *> \verbatim
00054 *>          NINFO is INTEGER
00055 *>          Number of examples returned with INFO .NE. 0.
00056 *> \endverbatim
00057 *>
00058 *> \param[out] KNT
00059 *> \verbatim
00060 *>          KNT is INTEGER
00061 *>          Total number of examples tested.
00062 *> \endverbatim
00063 *
00064 *  Authors:
00065 *  ========
00066 *
00067 *> \author Univ. of Tennessee 
00068 *> \author Univ. of California Berkeley 
00069 *> \author Univ. of Colorado Denver 
00070 *> \author NAG Ltd. 
00071 *
00072 *> \date November 2011
00073 *
00074 *> \ingroup double_eig
00075 *
00076 *  =====================================================================
00077       SUBROUTINE DGET33( RMAX, LMAX, NINFO, KNT )
00078 *
00079 *  -- LAPACK test routine (version 3.4.0) --
00080 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00081 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00082 *     November 2011
00083 *
00084 *     .. Scalar Arguments ..
00085       INTEGER            KNT, LMAX, NINFO
00086       DOUBLE PRECISION   RMAX
00087 *     ..
00088 *
00089 *  =====================================================================
00090 *
00091 *     .. Parameters ..
00092       DOUBLE PRECISION   ZERO, ONE
00093       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
00094       DOUBLE PRECISION   TWO, FOUR
00095       PARAMETER          ( TWO = 2.0D0, FOUR = 4.0D0 )
00096 *     ..
00097 *     .. Local Scalars ..
00098       INTEGER            I1, I2, I3, I4, IM1, IM2, IM3, IM4, J1, J2, J3
00099       DOUBLE PRECISION   BIGNUM, CS, EPS, RES, SMLNUM, SN, SUM, TNRM,
00100      $                   WI1, WI2, WR1, WR2
00101 *     ..
00102 *     .. Local Arrays ..
00103       DOUBLE PRECISION   Q( 2, 2 ), T( 2, 2 ), T1( 2, 2 ), T2( 2, 2 ),
00104      $                   VAL( 4 ), VM( 3 )
00105 *     ..
00106 *     .. External Functions ..
00107       DOUBLE PRECISION   DLAMCH
00108       EXTERNAL           DLAMCH
00109 *     ..
00110 *     .. External Subroutines ..
00111       EXTERNAL           DLABAD, DLANV2
00112 *     ..
00113 *     .. Intrinsic Functions ..
00114       INTRINSIC          ABS, MAX, SIGN
00115 *     ..
00116 *     .. Executable Statements ..
00117 *
00118 *     Get machine parameters
00119 *
00120       EPS = DLAMCH( 'P' )
00121       SMLNUM = DLAMCH( 'S' ) / EPS
00122       BIGNUM = ONE / SMLNUM
00123       CALL DLABAD( SMLNUM, BIGNUM )
00124 *
00125 *     Set up test case parameters
00126 *
00127       VAL( 1 ) = ONE
00128       VAL( 2 ) = ONE + TWO*EPS
00129       VAL( 3 ) = TWO
00130       VAL( 4 ) = TWO - FOUR*EPS
00131       VM( 1 ) = SMLNUM
00132       VM( 2 ) = ONE
00133       VM( 3 ) = BIGNUM
00134 *
00135       KNT = 0
00136       NINFO = 0
00137       LMAX = 0
00138       RMAX = ZERO
00139 *
00140 *     Begin test loop
00141 *
00142       DO 150 I1 = 1, 4
00143          DO 140 I2 = 1, 4
00144             DO 130 I3 = 1, 4
00145                DO 120 I4 = 1, 4
00146                   DO 110 IM1 = 1, 3
00147                      DO 100 IM2 = 1, 3
00148                         DO 90 IM3 = 1, 3
00149                            DO 80 IM4 = 1, 3
00150                               T( 1, 1 ) = VAL( I1 )*VM( IM1 )
00151                               T( 1, 2 ) = VAL( I2 )*VM( IM2 )
00152                               T( 2, 1 ) = -VAL( I3 )*VM( IM3 )
00153                               T( 2, 2 ) = VAL( I4 )*VM( IM4 )
00154                               TNRM = MAX( ABS( T( 1, 1 ) ),
00155      $                               ABS( T( 1, 2 ) ), ABS( T( 2, 1 ) ),
00156      $                               ABS( T( 2, 2 ) ) )
00157                               T1( 1, 1 ) = T( 1, 1 )
00158                               T1( 1, 2 ) = T( 1, 2 )
00159                               T1( 2, 1 ) = T( 2, 1 )
00160                               T1( 2, 2 ) = T( 2, 2 )
00161                               Q( 1, 1 ) = ONE
00162                               Q( 1, 2 ) = ZERO
00163                               Q( 2, 1 ) = ZERO
00164                               Q( 2, 2 ) = ONE
00165 *
00166                               CALL DLANV2( T( 1, 1 ), T( 1, 2 ),
00167      $                                     T( 2, 1 ), T( 2, 2 ), WR1,
00168      $                                     WI1, WR2, WI2, CS, SN )
00169                               DO 10 J1 = 1, 2
00170                                  RES = Q( J1, 1 )*CS + Q( J1, 2 )*SN
00171                                  Q( J1, 2 ) = -Q( J1, 1 )*SN +
00172      $                                        Q( J1, 2 )*CS
00173                                  Q( J1, 1 ) = RES
00174    10                         CONTINUE
00175 *
00176                               RES = ZERO
00177                               RES = RES + ABS( Q( 1, 1 )**2+
00178      $                              Q( 1, 2 )**2-ONE ) / EPS
00179                               RES = RES + ABS( Q( 2, 2 )**2+
00180      $                              Q( 2, 1 )**2-ONE ) / EPS
00181                               RES = RES + ABS( Q( 1, 1 )*Q( 2, 1 )+
00182      $                              Q( 1, 2 )*Q( 2, 2 ) ) / EPS
00183                               DO 40 J1 = 1, 2
00184                                  DO 30 J2 = 1, 2
00185                                     T2( J1, J2 ) = ZERO
00186                                     DO 20 J3 = 1, 2
00187                                        T2( J1, J2 ) = T2( J1, J2 ) +
00188      $                                                T1( J1, J3 )*
00189      $                                                Q( J3, J2 )
00190    20                               CONTINUE
00191    30                            CONTINUE
00192    40                         CONTINUE
00193                               DO 70 J1 = 1, 2
00194                                  DO 60 J2 = 1, 2
00195                                     SUM = T( J1, J2 )
00196                                     DO 50 J3 = 1, 2
00197                                        SUM = SUM - Q( J3, J1 )*
00198      $                                       T2( J3, J2 )
00199    50                               CONTINUE
00200                                     RES = RES + ABS( SUM ) / EPS / TNRM
00201    60                            CONTINUE
00202    70                         CONTINUE
00203                               IF( T( 2, 1 ).NE.ZERO .AND.
00204      $                            ( T( 1, 1 ).NE.T( 2,
00205      $                            2 ) .OR. SIGN( ONE, T( 1,
00206      $                            2 ) )*SIGN( ONE, T( 2,
00207      $                            1 ) ).GT.ZERO ) )RES = RES + ONE / EPS
00208                               KNT = KNT + 1
00209                               IF( RES.GT.RMAX ) THEN
00210                                  LMAX = KNT
00211                                  RMAX = RES
00212                               END IF
00213    80                      CONTINUE
00214    90                   CONTINUE
00215   100                CONTINUE
00216   110             CONTINUE
00217   120          CONTINUE
00218   130       CONTINUE
00219   140    CONTINUE
00220   150 CONTINUE
00221 *
00222       RETURN
00223 *
00224 *     End of DGET33
00225 *
00226       END
 All Files Functions