LAPACK: TESTING/LIN/schkrfp.f Source File

Go to the documentation of this file.
00001       PROGRAM SCHKRFP
00002 *
00003 *  -- LAPACK test routine (version 3.2.0) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2008
00006 *
00007 *  Purpose
00008 *  =======
00009 *
00010 *  SCHKRFP is the main test program for the REAL linear
00011 *  equation routines with RFP storage format
00012 *
00013 *
00014 *  Internal Parameters
00015 *  ===================
00016 *
00017 *  MAXIN   INTEGER
00018 *          The number of different values that can be used for each of
00019 *          M, N, or NB
00020 *
00021 *  MAXRHS  INTEGER
00022 *          The maximum number of right hand sides
00023 *
00024 *  NTYPES  INTEGER
00025 *
00026 *  NMAX    INTEGER
00027 *          The maximum allowable value for N.
00028 *
00029 *  NIN     INTEGER
00030 *          The unit number for input
00031 *
00032 *  NOUT    INTEGER
00033 *          The unit number for output
00034 *
00035 *  =====================================================================
00036 *
00037 *     .. Parameters ..
00038       INTEGER            MAXIN
00039       PARAMETER          ( MAXIN = 12 )
00040       INTEGER            NMAX
00041       PARAMETER          ( NMAX =  50 )
00042       INTEGER            MAXRHS
00043       PARAMETER          ( MAXRHS = 16 )
00044       INTEGER            NTYPES
00045       PARAMETER          ( NTYPES = 9 )
00046       INTEGER            NIN, NOUT
00047       PARAMETER          ( NIN = 5, NOUT = 6 )
00048 *     ..
00049 *     .. Local Scalars ..
00050       LOGICAL            FATAL, TSTERR
00051       INTEGER            VERS_MAJOR, VERS_MINOR, VERS_PATCH
00052       INTEGER            I, NN, NNS, NNT
00053       REAL               EPS, S1, S2, THRESH
00054 *     ..
00055 *     .. Local Arrays ..
00056       INTEGER            NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES )
00057       REAL               WORKA( NMAX, NMAX )
00058       REAL               WORKASAV( NMAX, NMAX )
00059       REAL               WORKB( NMAX, MAXRHS )
00060       REAL               WORKXACT( NMAX, MAXRHS )
00061       REAL               WORKBSAV( NMAX, MAXRHS )
00062       REAL               WORKX( NMAX, MAXRHS )
00063       REAL               WORKAFAC( NMAX, NMAX )
00064       REAL               WORKAINV( NMAX, NMAX )
00065       REAL               WORKARF( (NMAX*(NMAX+1))/2 )
00066       REAL               WORKAP( (NMAX*(NMAX+1))/2 )
00067       REAL               WORKARFINV( (NMAX*(NMAX+1))/2 )
00068       REAL               S_WORK_SLATMS( 3 * NMAX )
00069       REAL               S_WORK_SPOT01( NMAX )
00070       REAL               S_TEMP_SPOT02( NMAX, MAXRHS )
00071       REAL               S_TEMP_SPOT03( NMAX, NMAX )
00072       REAL               S_WORK_SLANSY( NMAX )
00073       REAL               S_WORK_SPOT02( NMAX )
00074       REAL               S_WORK_SPOT03( NMAX )
00075 *     ..
00076 *     .. External Functions ..
00077       REAL               SLAMCH, SECOND
00078       EXTERNAL           SLAMCH, SECOND
00079 *     ..
00080 *     .. External Subroutines ..
00081       EXTERNAL           ILAVER, SDRVRFP, SDRVRF1, SDRVRF2, SDRVRF3,
00082      +                   SDRVRF4
00083 *     ..
00084 *     .. Executable Statements ..
00085 *
00086       S1 = SECOND( )
00087       FATAL = .FALSE.
00088 *
00089 *     Read a dummy line.
00090 *
00091       READ( NIN, FMT = * )
00092 *
00093 *     Report LAPACK version tag (e.g. LAPACK-3.2.0)
00094 *
00095       CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
00096       WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
00097 *
00098 *     Read the values of N
00099 *
00100       READ( NIN, FMT = * )NN
00101       IF( NN.LT.1 ) THEN
00102          WRITE( NOUT, FMT = 9996 )' NN ', NN, 1
00103          NN = 0
00104          FATAL = .TRUE.
00105       ELSE IF( NN.GT.MAXIN ) THEN
00106          WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN
00107          NN = 0
00108          FATAL = .TRUE.
00109       END IF
00110       READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
00111       DO 10 I = 1, NN
00112          IF( NVAL( I ).LT.0 ) THEN
00113             WRITE( NOUT, FMT = 9996 )' M  ', NVAL( I ), 0
00114             FATAL = .TRUE.
00115          ELSE IF( NVAL( I ).GT.NMAX ) THEN
00116             WRITE( NOUT, FMT = 9995 )' M  ', NVAL( I ), NMAX
00117             FATAL = .TRUE.
00118          END IF
00119    10 CONTINUE
00120       IF( NN.GT.0 )
00121      $   WRITE( NOUT, FMT = 9993 )'N   ', ( NVAL( I ), I = 1, NN )
00122 *
00123 *     Read the values of NRHS
00124 *
00125       READ( NIN, FMT = * )NNS
00126       IF( NNS.LT.1 ) THEN
00127          WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
00128          NNS = 0
00129          FATAL = .TRUE.
00130       ELSE IF( NNS.GT.MAXIN ) THEN
00131          WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
00132          NNS = 0
00133          FATAL = .TRUE.
00134       END IF
00135       READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
00136       DO 30 I = 1, NNS
00137          IF( NSVAL( I ).LT.0 ) THEN
00138             WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
00139             FATAL = .TRUE.
00140          ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
00141             WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
00142             FATAL = .TRUE.
00143          END IF
00144    30 CONTINUE
00145       IF( NNS.GT.0 )
00146      $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
00147 *
00148 *     Read the matrix types
00149 *
00150       READ( NIN, FMT = * )NNT
00151       IF( NNT.LT.1 ) THEN
00152          WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1
00153          NNT = 0
00154          FATAL = .TRUE.
00155       ELSE IF( NNT.GT.NTYPES ) THEN
00156          WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES
00157          NNT = 0
00158          FATAL = .TRUE.
00159       END IF
00160       READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT )
00161       DO 320 I = 1, NNT
00162          IF( NTVAL( I ).LT.0 ) THEN
00163             WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0
00164             FATAL = .TRUE.
00165          ELSE IF( NTVAL( I ).GT.NTYPES ) THEN
00166             WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES
00167             FATAL = .TRUE.
00168          END IF
00169   320 CONTINUE
00170       IF( NNT.GT.0 )
00171      $   WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT )
00172 *
00173 *     Read the threshold value for the test ratios.
00174 *
00175       READ( NIN, FMT = * )THRESH
00176       WRITE( NOUT, FMT = 9992 )THRESH
00177 *
00178 *     Read the flag that indicates whether to test the error exits.
00179 *
00180       READ( NIN, FMT = * )TSTERR
00181 *
00182       IF( FATAL ) THEN
00183          WRITE( NOUT, FMT = 9999 )
00184          STOP
00185       END IF
00186 *
00187       IF( FATAL ) THEN
00188          WRITE( NOUT, FMT = 9999 )
00189          STOP
00190       END IF
00191 *
00192 *     Calculate and print the machine dependent constants.
00193 *
00194       EPS = SLAMCH( 'Underflow threshold' )
00195       WRITE( NOUT, FMT = 9991 )'underflow', EPS
00196       EPS = SLAMCH( 'Overflow threshold' )
00197       WRITE( NOUT, FMT = 9991 )'overflow ', EPS
00198       EPS = SLAMCH( 'Epsilon' )
00199       WRITE( NOUT, FMT = 9991 )'precision', EPS
00200       WRITE( NOUT, FMT = * )
00201 *
00202 *     Test the error exit of:
00203 *
00204       IF( TSTERR )
00205      $   CALL SERRRFP( NOUT )
00206 *
00207 *     Test the routines: spftrf, spftri, spftrs (as in SDRVPO).
00208 *     This also tests the routines: stfsm, stftri, stfttr, strttf.
00209 *
00210       CALL SDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH,
00211      $              WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB,
00212      $              WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV,
00213      $              S_WORK_SLATMS, S_WORK_SPOT01, S_TEMP_SPOT02,
00214      $              S_TEMP_SPOT03, S_WORK_SLANSY, S_WORK_SPOT02,
00215      $              S_WORK_SPOT03 )
00216 *
00217 *     Test the routine: slansf
00218 *
00219       CALL SDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
00220      +              S_WORK_SLANSY )
00221 *
00222 *     Test the convertion routines:
00223 *       stfttp, stpttf, stfttr, strttf, strttp and stpttr.
00224 *
00225       CALL SDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF,
00226      +              WORKAP, WORKASAV )
00227 *
00228 *     Test the routine: stfsm
00229 *
00230       CALL SDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
00231      +              WORKAINV, WORKAFAC, S_WORK_SLANSY,
00232      +              S_WORK_SPOT03, S_WORK_SPOT01 )
00233 *
00234 *
00235 *     Test the routine: ssfrk
00236 *
00237       CALL SDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX,
00238      +              WORKARF, WORKAINV, NMAX, S_WORK_SLANSY)
00239 *
00240       CLOSE ( NIN )
00241       S2 = SECOND( )
00242       WRITE( NOUT, FMT = 9998 )
00243       WRITE( NOUT, FMT = 9997 )S2 - S1
00244 *
00245  9999 FORMAT( / ' Execution not attempted due to input errors' )
00246  9998 FORMAT( / ' End of tests' )
00247  9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
00248  9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=',
00249      $      I6 )
00250  9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=',
00251      $      I6 )
00252  9994 FORMAT( /  ' Tests of the REAL LAPACK RFP routines ',
00253      $      / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
00254      $      / / ' The following parameter values will be used:' )
00255  9993 FORMAT( 4X, A4, ':  ', 10I6, / 11X, 10I6 )
00256  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
00257      $      'less than', F8.2, / )
00258  9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
00259 *
00260 *     End of SCHKRFP
00261 *
00262       END