LAPACK: TESTING/LIN/dchkrfp.f Source File

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