LAPACK: TESTING/EIG/schkec.f Source File

Go to the documentation of this file.
00001       SUBROUTINE SCHKEC( 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       REAL               THRESH
00011 *     ..
00012 *
00013 *  Purpose
00014 *  =======
00015 *
00016 *  SCHKEC tests eigen- condition estimation routines
00017 *         SLALN2, SLASY2, SLANV2, SLAQTR, SLAEXC,
00018 *         STRSYL, STREXC, STRSNA, STRSEN
00019 *
00020 *  In all cases, the routine runs through a fixed set of numerical
00021 *  examples, subjects them to various tests, and compares the test
00022 *  results to a threshold THRESH. In addition, STREXC, STRSNA and STRSEN
00023 *  are tested by reading in precomputed examples from a file (on input
00024 *  unit NIN).  Output is written to output unit NOUT.
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  THRESH  (input) REAL
00030 *          Threshold for residual tests.  A computed test ratio passes
00031 *          the threshold if it is less than THRESH.
00032 *
00033 *  TSTERR  (input) LOGICAL
00034 *          Flag that indicates whether error exits are to be tested.
00035 *
00036 *  NIN     (input) INTEGER
00037 *          The logical unit number for input.
00038 *
00039 *  NOUT    (input) INTEGER
00040 *          The logical unit number for output.
00041 *
00042 *  =====================================================================
00043 *
00044 *     .. Local Scalars ..
00045       LOGICAL            OK
00046       CHARACTER*3        PATH
00047       INTEGER            KLAEXC, KLALN2, KLANV2, KLAQTR, KLASY2, KTREXC,
00048      $                   KTRSEN, KTRSNA, KTRSYL, LLAEXC, LLALN2, LLANV2,
00049      $                   LLAQTR, LLASY2, LTREXC, LTRSYL, NLANV2, NLAQTR,
00050      $                   NLASY2, NTESTS, NTRSYL
00051       REAL               EPS, RLAEXC, RLALN2, RLANV2, RLAQTR, RLASY2,
00052      $                   RTREXC, RTRSYL, SFMIN
00053 *     ..
00054 *     .. Local Arrays ..
00055       INTEGER            LTRSEN( 3 ), LTRSNA( 3 ), NLAEXC( 2 ),
00056      $                   NLALN2( 2 ), NTREXC( 3 ), NTRSEN( 3 ),
00057      $                   NTRSNA( 3 )
00058       REAL               RTRSEN( 3 ), RTRSNA( 3 )
00059 *     ..
00060 *     .. External Subroutines ..
00061       EXTERNAL           SERREC, SGET31, SGET32, SGET33, SGET34, SGET35,
00062      $                   SGET36, SGET37, SGET38, SGET39
00063 *     ..
00064 *     .. External Functions ..
00065       REAL               SLAMCH
00066       EXTERNAL           SLAMCH
00067 *     ..
00068 *     .. Executable Statements ..
00069 *
00070       PATH( 1: 1 ) = 'Single precision'
00071       PATH( 2: 3 ) = 'EC'
00072       EPS = SLAMCH( 'P' )
00073       SFMIN = SLAMCH( 'S' )
00074 *
00075 *     Print header information
00076 *
00077       WRITE( NOUT, FMT = 9989 )
00078       WRITE( NOUT, FMT = 9988 )EPS, SFMIN
00079       WRITE( NOUT, FMT = 9987 )THRESH
00080 *
00081 *     Test error exits if TSTERR is .TRUE.
00082 *
00083       IF( TSTERR )
00084      $   CALL SERREC( PATH, NOUT )
00085 *
00086       OK = .TRUE.
00087       CALL SGET31( RLALN2, LLALN2, NLALN2, KLALN2 )
00088       IF( RLALN2.GT.THRESH .OR. NLALN2( 1 ).NE.0 ) THEN
00089          OK = .FALSE.
00090          WRITE( NOUT, FMT = 9999 )RLALN2, LLALN2, NLALN2, KLALN2
00091       END IF
00092 *
00093       CALL SGET32( RLASY2, LLASY2, NLASY2, KLASY2 )
00094       IF( RLASY2.GT.THRESH ) THEN
00095          OK = .FALSE.
00096          WRITE( NOUT, FMT = 9998 )RLASY2, LLASY2, NLASY2, KLASY2
00097       END IF
00098 *
00099       CALL SGET33( RLANV2, LLANV2, NLANV2, KLANV2 )
00100       IF( RLANV2.GT.THRESH .OR. NLANV2.NE.0 ) THEN
00101          OK = .FALSE.
00102          WRITE( NOUT, FMT = 9997 )RLANV2, LLANV2, NLANV2, KLANV2
00103       END IF
00104 *
00105       CALL SGET34( RLAEXC, LLAEXC, NLAEXC, KLAEXC )
00106       IF( RLAEXC.GT.THRESH .OR. NLAEXC( 2 ).NE.0 ) THEN
00107          OK = .FALSE.
00108          WRITE( NOUT, FMT = 9996 )RLAEXC, LLAEXC, NLAEXC, KLAEXC
00109       END IF
00110 *
00111       CALL SGET35( RTRSYL, LTRSYL, NTRSYL, KTRSYL )
00112       IF( RTRSYL.GT.THRESH ) THEN
00113          OK = .FALSE.
00114          WRITE( NOUT, FMT = 9995 )RTRSYL, LTRSYL, NTRSYL, KTRSYL
00115       END IF
00116 *
00117       CALL SGET36( RTREXC, LTREXC, NTREXC, KTREXC, NIN )
00118       IF( RTREXC.GT.THRESH .OR. NTREXC( 3 ).GT.0 ) THEN
00119          OK = .FALSE.
00120          WRITE( NOUT, FMT = 9994 )RTREXC, LTREXC, NTREXC, KTREXC
00121       END IF
00122 *
00123       CALL SGET37( RTRSNA, LTRSNA, NTRSNA, KTRSNA, NIN )
00124       IF( RTRSNA( 1 ).GT.THRESH .OR. RTRSNA( 2 ).GT.THRESH .OR.
00125      $    NTRSNA( 1 ).NE.0 .OR. NTRSNA( 2 ).NE.0 .OR. NTRSNA( 3 ).NE.0 )
00126      $     THEN
00127          OK = .FALSE.
00128          WRITE( NOUT, FMT = 9993 )RTRSNA, LTRSNA, NTRSNA, KTRSNA
00129       END IF
00130 *
00131       CALL SGET38( RTRSEN, LTRSEN, NTRSEN, KTRSEN, NIN )
00132       IF( RTRSEN( 1 ).GT.THRESH .OR. RTRSEN( 2 ).GT.THRESH .OR.
00133      $    NTRSEN( 1 ).NE.0 .OR. NTRSEN( 2 ).NE.0 .OR. NTRSEN( 3 ).NE.0 )
00134      $     THEN
00135          OK = .FALSE.
00136          WRITE( NOUT, FMT = 9992 )RTRSEN, LTRSEN, NTRSEN, KTRSEN
00137       END IF
00138 *
00139       CALL SGET39( RLAQTR, LLAQTR, NLAQTR, KLAQTR )
00140       IF( RLAQTR.GT.THRESH ) THEN
00141          OK = .FALSE.
00142          WRITE( NOUT, FMT = 9991 )RLAQTR, LLAQTR, NLAQTR, KLAQTR
00143       END IF
00144 *
00145       NTESTS = KLALN2 + KLASY2 + KLANV2 + KLAEXC + KTRSYL + KTREXC +
00146      $         KTRSNA + KTRSEN + KLAQTR
00147       IF( OK )
00148      $   WRITE( NOUT, FMT = 9990 )PATH, NTESTS
00149 *
00150       RETURN
00151  9999 FORMAT( ' Error in SLALN2: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
00152      $      'INFO=', 2I8, ' KNT=', I8 )
00153  9998 FORMAT( ' Error in SLASY2: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
00154      $      'INFO=', I8, ' KNT=', I8 )
00155  9997 FORMAT( ' Error in SLANV2: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
00156      $      'INFO=', I8, ' KNT=', I8 )
00157  9996 FORMAT( ' Error in SLAEXC: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
00158      $      'INFO=', 2I8, ' KNT=', I8 )
00159  9995 FORMAT( ' Error in STRSYL: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
00160      $      'INFO=', I8, ' KNT=', I8 )
00161  9994 FORMAT( ' Error in STREXC: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
00162      $      'INFO=', 3I8, ' KNT=', I8 )
00163  9993 FORMAT( ' Error in STRSNA: RMAX =', 3E12.3, / ' LMAX = ', 3I8,
00164      $      ' NINFO=', 3I8, ' KNT=', I8 )
00165  9992 FORMAT( ' Error in STRSEN: RMAX =', 3E12.3, / ' LMAX = ', 3I8,
00166      $      ' NINFO=', 3I8, ' KNT=', I8 )
00167  9991 FORMAT( ' Error in SLAQTR: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
00168      $      'INFO=', I8, ' KNT=', I8 )
00169  9990 FORMAT( / 1X, 'All tests for ', A3, ' routines passed the thresh',
00170      $      'old (', I6, ' tests run)' )
00171  9989 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition estim',
00172      $      'ation routines', / ' SLALN2, SLASY2, SLANV2, SLAEXC, STRS',
00173      $      'YL, STREXC, STRSNA, STRSEN, SLAQTR', / )
00174  9988 FORMAT( ' Relative machine precision (EPS) = ', E16.6, / ' Safe ',
00175      $      'minimum (SFMIN)             = ', E16.6, / )
00176  9987 FORMAT( ' Routines pass computational tests if test ratio is les',
00177      $      's than', F8.2, / / )
00178 *
00179 *     End of SCHKEC
00180 *
00181       END