LAPACK 3.3.1
Linear Algebra PACKage

zchkrfp.f

Go to the documentation of this file.
00001       PROGRAM ZCHKRFP
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 *  ZCHKRFP is the main test program for the COMPLEX*16 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       DOUBLE PRECISION   EPS, S1, S2, THRESH
00055 
00056 *     ..
00057 *     .. Local Arrays ..
00058       INTEGER            NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES )
00059       COMPLEX*16         WORKA( NMAX, NMAX )
00060       COMPLEX*16         WORKASAV( NMAX, NMAX )
00061       COMPLEX*16         WORKB( NMAX, MAXRHS )
00062       COMPLEX*16         WORKXACT( NMAX, MAXRHS )
00063       COMPLEX*16         WORKBSAV( NMAX, MAXRHS )
00064       COMPLEX*16         WORKX( NMAX, MAXRHS )
00065       COMPLEX*16         WORKAFAC( NMAX, NMAX )
00066       COMPLEX*16         WORKAINV( NMAX, NMAX )
00067       COMPLEX*16         WORKARF( (NMAX*(NMAX+1))/2 )
00068       COMPLEX*16         WORKAP( (NMAX*(NMAX+1))/2 )
00069       COMPLEX*16         WORKARFINV( (NMAX*(NMAX+1))/2 )
00070       COMPLEX*16         Z_WORK_ZLATMS( 3 * NMAX )
00071       COMPLEX*16         Z_WORK_ZPOT02( NMAX, MAXRHS )
00072       COMPLEX*16         Z_WORK_ZPOT03( NMAX, NMAX )
00073       DOUBLE PRECISION   D_WORK_ZLATMS( NMAX )
00074       DOUBLE PRECISION   D_WORK_ZLANHE( NMAX )
00075       DOUBLE PRECISION   D_WORK_ZPOT01( NMAX )
00076       DOUBLE PRECISION   D_WORK_ZPOT02( NMAX )
00077       DOUBLE PRECISION   D_WORK_ZPOT03( NMAX )
00078 *     ..
00079 *     .. External Functions ..
00080       DOUBLE PRECISION   DLAMCH, DSECND
00081       EXTERNAL           DLAMCH, DSECND
00082 *     ..
00083 *     .. External Subroutines ..
00084       EXTERNAL           ILAVER, ZDRVRFP, ZDRVRF1, ZDRVRF2, ZDRVRF3,
00085      +                   ZDRVRF4
00086 *     ..
00087 *     .. Executable Statements ..
00088 *
00089       S1 = DSECND( )
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 = DLAMCH( 'Underflow threshold' )
00198       WRITE( NOUT, FMT = 9991 )'underflow', EPS
00199       EPS = DLAMCH( 'Overflow threshold' )
00200       WRITE( NOUT, FMT = 9991 )'overflow ', EPS
00201       EPS = DLAMCH( '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 ZERRRFP( NOUT )
00209 *
00210 *    Test the routines: zpftrf, zpftri, zpftrs (as in ZDRVPO).
00211 *    This also tests the routines: ztfsm, ztftri, ztfttr, ztrttf.
00212 *
00213       CALL ZDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH,
00214      $              WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB,
00215      $              WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV,
00216      $              Z_WORK_ZLATMS, Z_WORK_ZPOT02,
00217      $              Z_WORK_ZPOT03, D_WORK_ZLATMS, D_WORK_ZLANHE,
00218      $              D_WORK_ZPOT01, D_WORK_ZPOT02, D_WORK_ZPOT03 )
00219 *
00220 *    Test the routine: zlanhf
00221 *
00222       CALL ZDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
00223      +              D_WORK_ZLANHE )
00224 *
00225 *    Test the convertion routines:
00226 *       zhfttp, ztpthf, ztfttr, ztrttf, ztrttp and ztpttr.
00227 *
00228       CALL ZDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF,
00229      +              WORKAP, WORKASAV )
00230 *
00231 *    Test the routine: ztfsm
00232 *
00233       CALL ZDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
00234      +              WORKAINV, WORKAFAC, D_WORK_ZLANHE,
00235      +              Z_WORK_ZPOT03, Z_WORK_ZPOT02 )
00236  
00237 *
00238 *    Test the routine: zhfrk
00239 *
00240       CALL ZDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX,
00241      +              WORKARF, WORKAINV, NMAX,D_WORK_ZLANHE)
00242 *
00243       CLOSE ( NIN )
00244       S2 = DSECND( )
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*16 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 ZCHKRFP
00264 *
00265       END
 All Files Functions