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