|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
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
1.7.3 
