LAPACK: TESTING/LIN/cchkrfp.f Source File

Go to the documentation of this file.
00001       PROGRAM CCHKRFP
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 *  CCHKRFP is the main test program for the COMPLEX linear equation
00012 *  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       REAL               EPS, S1, S2, THRESH
00055 
00056 *     ..
00057 *     .. Local Arrays ..
00058       INTEGER            NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES )
00059       COMPLEX            WORKA( NMAX, NMAX )
00060       COMPLEX            WORKASAV( NMAX, NMAX )
00061       COMPLEX            WORKB( NMAX, MAXRHS )
00062       COMPLEX            WORKXACT( NMAX, MAXRHS )
00063       COMPLEX            WORKBSAV( NMAX, MAXRHS )
00064       COMPLEX            WORKX( NMAX, MAXRHS )
00065       COMPLEX            WORKAFAC( NMAX, NMAX )
00066       COMPLEX            WORKAINV( NMAX, NMAX )
00067       COMPLEX            WORKARF( (NMAX*(NMAX+1))/2 )
00068       COMPLEX            WORKAP( (NMAX*(NMAX+1))/2 )
00069       COMPLEX            WORKARFINV( (NMAX*(NMAX+1))/2 )
00070       COMPLEX            C_WORK_CLATMS( 3 * NMAX )
00071       COMPLEX            C_WORK_CPOT02( NMAX, MAXRHS )
00072       COMPLEX            C_WORK_CPOT03( NMAX, NMAX )
00073       REAL               S_WORK_CLATMS( NMAX )
00074       REAL               S_WORK_CLANHE( NMAX )
00075       REAL               S_WORK_CPOT01( NMAX )
00076       REAL               S_WORK_CPOT02( NMAX )
00077       REAL               S_WORK_CPOT03( NMAX )
00078 *     ..
00079 *     .. External Functions ..
00080       REAL               SLAMCH, SECOND
00081       EXTERNAL           SLAMCH, SECOND
00082 *     ..
00083 *     .. External Subroutines ..
00084       EXTERNAL           ILAVER, CDRVRFP, CDRVRF1, CDRVRF2, CDRVRF3,
00085      +                   CDRVRF4
00086 *     ..
00087 *     .. Executable Statements ..
00088 *
00089       S1 = SECOND( )
00090       FATAL = .FALSE.
00091 *
00092 *     Read a dummy line.
00093 *
00094       READ( NIN, FMT = * )
00095 *
00096 *     Report LAPACK version tag (e.g. LAPACK-3.2.0)
00097 *
00098       CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
00099       WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
00100 *
00101 *     Read the values of N
00102 *
00103       READ( NIN, FMT = * )NN
00104       IF( NN.LT.1 ) THEN
00105          WRITE( NOUT, FMT = 9996 )' NN ', NN, 1
00106          NN = 0
00107          FATAL = .TRUE.
00108       ELSE IF( NN.GT.MAXIN ) THEN
00109          WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN
00110          NN = 0
00111          FATAL = .TRUE.
00112       END IF
00113       READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
00114       DO 10 I = 1, NN
00115          IF( NVAL( I ).LT.0 ) THEN
00116             WRITE( NOUT, FMT = 9996 )' M  ', NVAL( I ), 0
00117             FATAL = .TRUE.
00118          ELSE IF( NVAL( I ).GT.NMAX ) THEN
00119             WRITE( NOUT, FMT = 9995 )' M  ', NVAL( I ), NMAX
00120             FATAL = .TRUE.
00121          END IF
00122    10 CONTINUE
00123       IF( NN.GT.0 )
00124      $   WRITE( NOUT, FMT = 9993 )'N   ', ( NVAL( I ), I = 1, NN )
00125 *
00126 *     Read the values of NRHS
00127 *
00128       READ( NIN, FMT = * )NNS
00129       IF( NNS.LT.1 ) THEN
00130          WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
00131          NNS = 0
00132          FATAL = .TRUE.
00133       ELSE IF( NNS.GT.MAXIN ) THEN
00134          WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
00135          NNS = 0
00136          FATAL = .TRUE.
00137       END IF
00138       READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
00139       DO 30 I = 1, NNS
00140          IF( NSVAL( I ).LT.0 ) THEN
00141             WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
00142             FATAL = .TRUE.
00143          ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
00144             WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
00145             FATAL = .TRUE.
00146          END IF
00147    30 CONTINUE
00148       IF( NNS.GT.0 )
00149      $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
00150 *
00151 *     Read the matrix types
00152 *
00153       READ( NIN, FMT = * )NNT
00154       IF( NNT.LT.1 ) THEN
00155          WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1
00156          NNT = 0
00157          FATAL = .TRUE.
00158       ELSE IF( NNT.GT.NTYPES ) THEN
00159          WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES
00160          NNT = 0
00161          FATAL = .TRUE.
00162       END IF
00163       READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT )
00164       DO 320 I = 1, NNT
00165          IF( NTVAL( I ).LT.0 ) THEN
00166             WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0
00167             FATAL = .TRUE.
00168          ELSE IF( NTVAL( I ).GT.NTYPES ) THEN
00169             WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES
00170             FATAL = .TRUE.
00171          END IF
00172   320 CONTINUE
00173       IF( NNT.GT.0 )
00174      $   WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT )
00175 *
00176 *     Read the threshold value for the test ratios.
00177 *
00178       READ( NIN, FMT = * )THRESH
00179       WRITE( NOUT, FMT = 9992 )THRESH
00180 *
00181 *     Read the flag that indicates whether to test the error exits.
00182 *
00183       READ( NIN, FMT = * )TSTERR
00184 *
00185       IF( FATAL ) THEN
00186          WRITE( NOUT, FMT = 9999 )
00187          STOP
00188       END IF
00189 *
00190       IF( FATAL ) THEN
00191          WRITE( NOUT, FMT = 9999 )
00192          STOP
00193       END IF
00194 *
00195 *     Calculate and print the machine dependent constants.
00196 *
00197       EPS = SLAMCH( 'Underflow threshold' )
00198       WRITE( NOUT, FMT = 9991 )'underflow', EPS
00199       EPS = SLAMCH( 'Overflow threshold' )
00200       WRITE( NOUT, FMT = 9991 )'overflow ', EPS
00201       EPS = SLAMCH( 'Epsilon' )
00202       WRITE( NOUT, FMT = 9991 )'precision', EPS
00203       WRITE( NOUT, FMT = * )
00204 *
00205 *     Test the error exit of:
00206 *
00207       IF( TSTERR )
00208      $   CALL CERRRFP( NOUT )
00209 *
00210 *    Test the routines: cpftrf, cpftri, cpftrs (as in CDRVPO).
00211 *    This also tests the routines: ctfsm, ctftri, ctfttr, ctrttf.
00212 *
00213       CALL CDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH,
00214      $              WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB,
00215      $              WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV,
00216      $              C_WORK_CLATMS, C_WORK_CPOT02,
00217      $              C_WORK_CPOT03, S_WORK_CLATMS, S_WORK_CLANHE,
00218      $              S_WORK_CPOT01, S_WORK_CPOT02, S_WORK_CPOT03 )
00219 *
00220 *    Test the routine: clanhf
00221 *
00222       CALL CDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
00223      +              S_WORK_CLANHE )
00224 *
00225 *    Test the convertion routines:
00226 *       chfttp, ctpthf, ctfttr, ctrttf, ctrttp and ctpttr.
00227 *
00228       CALL CDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF,
00229      +              WORKAP, WORKASAV )
00230 *
00231 *    Test the routine: ctfsm
00232 *
00233       CALL CDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
00234      +              WORKAINV, WORKAFAC, S_WORK_CLANHE,
00235      +              C_WORK_CPOT03, C_WORK_CPOT02 )
00236 *
00237 *
00238 *    Test the routine: chfrk
00239 *
00240       CALL CDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX,
00241      +              WORKARF, WORKAINV, NMAX, S_WORK_CLANHE)
00242 *
00243       CLOSE ( NIN )
00244       S2 = SECOND( )
00245       WRITE( NOUT, FMT = 9998 )
00246       WRITE( NOUT, FMT = 9997 )S2 - S1
00247 *
00248  9999 FORMAT( / ' Execution not attempted due to input errors' )
00249  9998 FORMAT( / ' End of tests' )
00250  9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
00251  9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=',
00252      $      I6 )
00253  9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=',
00254      $      I6 )
00255  9994 FORMAT( /  ' Tests of the COMPLEX LAPACK RFP routines ',
00256      $      / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
00257      $      / / ' The following parameter values will be used:' )
00258  9993 FORMAT( 4X, A4, ':  ', 10I6, / 11X, 10I6 )
00259  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
00260      $      'less than', F8.2, / )
00261  9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
00262 *
00263 *     End of CCHKRFP
00264 *
00265       END