LAPACK: TESTING/EIG/zchkec.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZCHKEC( THRESH, TSTERR, NIN, NOUT )
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       LOGICAL            TSTERR
00009       INTEGER            NIN, NOUT
00010       DOUBLE PRECISION   THRESH
00011 *     ..
00012 *
00013 *  Purpose
00014 *  =======
00015 *
00016 *  ZCHKEC tests eigen- condition estimation routines
00017 *         ZTRSYL, CTREXC, CTRSNA, CTRSEN
00018 *
00019 *  In all cases, the routine runs through a fixed set of numerical
00020 *  examples, subjects them to various tests, and compares the test
00021 *  results to a threshold THRESH. In addition, ZTRSNA and CTRSEN are
00022 *  tested by reading in precomputed examples from a file (on input unit
00023 *  NIN).  Output is written to output unit NOUT.
00024 *
00025 *  Arguments
00026 *  =========
00027 *
00028 *  THRESH  (input) DOUBLE PRECISION
00029 *          Threshold for residual tests.  A computed test ratio passes
00030 *          the threshold if it is less than THRESH.
00031 *
00032 *  TSTERR  (input) LOGICAL
00033 *          Flag that indicates whether error exits are to be tested.
00034 *
00035 *  NIN     (input) INTEGER
00036 *          The logical unit number for input.
00037 *
00038 *  NOUT    (input) INTEGER
00039 *          The logical unit number for output.
00040 *
00041 *  =====================================================================
00042 *
00043 *     .. Local Scalars ..
00044       LOGICAL            OK
00045       CHARACTER*3        PATH
00046       INTEGER            KTREXC, KTRSEN, KTRSNA, KTRSYL, LTREXC, LTRSYL,
00047      $                   NTESTS, NTREXC, NTRSYL
00048       DOUBLE PRECISION   EPS, RTREXC, RTRSYL, SFMIN
00049 *     ..
00050 *     .. Local Arrays ..
00051       INTEGER            LTRSEN( 3 ), LTRSNA( 3 ), NTRSEN( 3 ),
00052      $                   NTRSNA( 3 )
00053       DOUBLE PRECISION   RTRSEN( 3 ), RTRSNA( 3 )
00054 *     ..
00055 *     .. External Subroutines ..
00056       EXTERNAL           ZERREC, ZGET35, ZGET36, ZGET37, ZGET38
00057 *     ..
00058 *     .. External Functions ..
00059       DOUBLE PRECISION   DLAMCH
00060       EXTERNAL           DLAMCH
00061 *     ..
00062 *     .. Executable Statements ..
00063 *
00064       PATH( 1: 1 ) = 'Zomplex precision'
00065       PATH( 2: 3 ) = 'EC'
00066       EPS = DLAMCH( 'P' )
00067       SFMIN = DLAMCH( 'S' )
00068       WRITE( NOUT, FMT = 9994 )
00069       WRITE( NOUT, FMT = 9993 )EPS, SFMIN
00070       WRITE( NOUT, FMT = 9992 )THRESH
00071 *
00072 *     Test error exits if TSTERR is .TRUE.
00073 *
00074       IF( TSTERR )
00075      $   CALL ZERREC( PATH, NOUT )
00076 *
00077       OK = .TRUE.
00078       CALL ZGET35( RTRSYL, LTRSYL, NTRSYL, KTRSYL, NIN )
00079       IF( RTRSYL.GT.THRESH ) THEN
00080          OK = .FALSE.
00081          WRITE( NOUT, FMT = 9999 )RTRSYL, LTRSYL, NTRSYL, KTRSYL
00082       END IF
00083 *
00084       CALL ZGET36( RTREXC, LTREXC, NTREXC, KTREXC, NIN )
00085       IF( RTREXC.GT.THRESH .OR. NTREXC.GT.0 ) THEN
00086          OK = .FALSE.
00087          WRITE( NOUT, FMT = 9998 )RTREXC, LTREXC, NTREXC, KTREXC
00088       END IF
00089 *
00090       CALL ZGET37( RTRSNA, LTRSNA, NTRSNA, KTRSNA, NIN )
00091       IF( RTRSNA( 1 ).GT.THRESH .OR. RTRSNA( 2 ).GT.THRESH .OR.
00092      $    NTRSNA( 1 ).NE.0 .OR. NTRSNA( 2 ).NE.0 .OR. NTRSNA( 3 ).NE.0 )
00093      $     THEN
00094          OK = .FALSE.
00095          WRITE( NOUT, FMT = 9997 )RTRSNA, LTRSNA, NTRSNA, KTRSNA
00096       END IF
00097 *
00098       CALL ZGET38( RTRSEN, LTRSEN, NTRSEN, KTRSEN, NIN )
00099       IF( RTRSEN( 1 ).GT.THRESH .OR. RTRSEN( 2 ).GT.THRESH .OR.
00100      $    NTRSEN( 1 ).NE.0 .OR. NTRSEN( 2 ).NE.0 .OR. NTRSEN( 3 ).NE.0 )
00101      $     THEN
00102          OK = .FALSE.
00103          WRITE( NOUT, FMT = 9996 )RTRSEN, LTRSEN, NTRSEN, KTRSEN
00104       END IF
00105 *
00106       NTESTS = KTRSYL + KTREXC + KTRSNA + KTRSEN
00107       IF( OK )
00108      $   WRITE( NOUT, FMT = 9995 )PATH, NTESTS
00109 *
00110  9999 FORMAT( ' Error in ZTRSYL: RMAX =', D12.3, / ' LMAX = ', I8,
00111      $      ' NINFO=', I8, ' KNT=', I8 )
00112  9998 FORMAT( ' Error in ZTREXC: RMAX =', D12.3, / ' LMAX = ', I8,
00113      $      ' NINFO=', I8, ' KNT=', I8 )
00114  9997 FORMAT( ' Error in ZTRSNA: RMAX =', 3D12.3, / ' LMAX = ', 3I8,
00115      $      ' NINFO=', 3I8, ' KNT=', I8 )
00116  9996 FORMAT( ' Error in ZTRSEN: RMAX =', 3D12.3, / ' LMAX = ', 3I8,
00117      $      ' NINFO=', 3I8, ' KNT=', I8 )
00118  9995 FORMAT( / 1X, 'All tests for ', A3,
00119      $      ' routines passed the threshold (', I6, ' tests run)' )
00120  9994 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition',
00121      $      ' estimation routines', / ' ZTRSYL, CTREXC, CTRSNA, CTRSEN',
00122      $      / )
00123  9993 FORMAT( ' Relative machine precision (EPS) = ', D16.6,
00124      $      / ' Safe minimum (SFMIN)             = ', D16.6, / )
00125  9992 FORMAT( ' Routines pass computational tests if test ratio is ',
00126      $      'less than', F8.2, / / )
00127       RETURN
00128 *
00129 *     End of ZCHKEC
00130 *
00131       END