![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZCHKRFP 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 ZCHKRFP 00012 * 00013 * 00014 *> \par Purpose: 00015 * ============= 00016 *> 00017 *> \verbatim 00018 *> 00019 *> ZCHKRFP is the main test program for the COMPLEX*16 linear equation 00020 *> 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 April 2012 00056 * 00057 *> \ingroup complex16_lin 00058 * 00059 * ===================================================================== 00060 PROGRAM ZCHKRFP 00061 * 00062 * -- LAPACK test routine (version 3.4.1) -- 00063 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00064 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00065 * April 2012 00066 * 00067 * ===================================================================== 00068 * 00069 * .. Parameters .. 00070 INTEGER MAXIN 00071 PARAMETER ( MAXIN = 12 ) 00072 INTEGER NMAX 00073 PARAMETER ( NMAX = 50 ) 00074 INTEGER MAXRHS 00075 PARAMETER ( MAXRHS = 16 ) 00076 INTEGER NTYPES 00077 PARAMETER ( NTYPES = 9 ) 00078 INTEGER NIN, NOUT 00079 PARAMETER ( NIN = 5, NOUT = 6 ) 00080 * .. 00081 * .. Local Scalars .. 00082 LOGICAL FATAL, TSTERR 00083 INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH 00084 INTEGER I, NN, NNS, NNT 00085 DOUBLE PRECISION EPS, S1, S2, THRESH 00086 00087 * .. 00088 * .. Local Arrays .. 00089 INTEGER NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES ) 00090 COMPLEX*16 WORKA( NMAX, NMAX ) 00091 COMPLEX*16 WORKASAV( NMAX, NMAX ) 00092 COMPLEX*16 WORKB( NMAX, MAXRHS ) 00093 COMPLEX*16 WORKXACT( NMAX, MAXRHS ) 00094 COMPLEX*16 WORKBSAV( NMAX, MAXRHS ) 00095 COMPLEX*16 WORKX( NMAX, MAXRHS ) 00096 COMPLEX*16 WORKAFAC( NMAX, NMAX ) 00097 COMPLEX*16 WORKAINV( NMAX, NMAX ) 00098 COMPLEX*16 WORKARF( (NMAX*(NMAX+1))/2 ) 00099 COMPLEX*16 WORKAP( (NMAX*(NMAX+1))/2 ) 00100 COMPLEX*16 WORKARFINV( (NMAX*(NMAX+1))/2 ) 00101 COMPLEX*16 Z_WORK_ZLATMS( 3 * NMAX ) 00102 COMPLEX*16 Z_WORK_ZPOT02( NMAX, MAXRHS ) 00103 COMPLEX*16 Z_WORK_ZPOT03( NMAX, NMAX ) 00104 DOUBLE PRECISION D_WORK_ZLATMS( NMAX ) 00105 DOUBLE PRECISION D_WORK_ZLANHE( NMAX ) 00106 DOUBLE PRECISION D_WORK_ZPOT01( NMAX ) 00107 DOUBLE PRECISION D_WORK_ZPOT02( NMAX ) 00108 DOUBLE PRECISION D_WORK_ZPOT03( NMAX ) 00109 * .. 00110 * .. External Functions .. 00111 DOUBLE PRECISION DLAMCH, DSECND 00112 EXTERNAL DLAMCH, DSECND 00113 * .. 00114 * .. External Subroutines .. 00115 EXTERNAL ILAVER, ZDRVRFP, ZDRVRF1, ZDRVRF2, ZDRVRF3, 00116 + ZDRVRF4 00117 * .. 00118 * .. Executable Statements .. 00119 * 00120 S1 = DSECND( ) 00121 FATAL = .FALSE. 00122 * 00123 * Read a dummy line. 00124 * 00125 READ( NIN, FMT = * ) 00126 * 00127 * Report LAPACK version tag (e.g. LAPACK-3.2.0) 00128 * 00129 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) 00130 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH 00131 * 00132 * Read the values of N 00133 * 00134 READ( NIN, FMT = * )NN 00135 IF( NN.LT.1 ) THEN 00136 WRITE( NOUT, FMT = 9996 )' NN ', NN, 1 00137 NN = 0 00138 FATAL = .TRUE. 00139 ELSE IF( NN.GT.MAXIN ) THEN 00140 WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN 00141 NN = 0 00142 FATAL = .TRUE. 00143 END IF 00144 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN ) 00145 DO 10 I = 1, NN 00146 IF( NVAL( I ).LT.0 ) THEN 00147 WRITE( NOUT, FMT = 9996 )' M ', NVAL( I ), 0 00148 FATAL = .TRUE. 00149 ELSE IF( NVAL( I ).GT.NMAX ) THEN 00150 WRITE( NOUT, FMT = 9995 )' M ', NVAL( I ), NMAX 00151 FATAL = .TRUE. 00152 END IF 00153 10 CONTINUE 00154 IF( NN.GT.0 ) 00155 $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN ) 00156 * 00157 * Read the values of NRHS 00158 * 00159 READ( NIN, FMT = * )NNS 00160 IF( NNS.LT.1 ) THEN 00161 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 00162 NNS = 0 00163 FATAL = .TRUE. 00164 ELSE IF( NNS.GT.MAXIN ) THEN 00165 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN 00166 NNS = 0 00167 FATAL = .TRUE. 00168 END IF 00169 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) 00170 DO 30 I = 1, NNS 00171 IF( NSVAL( I ).LT.0 ) THEN 00172 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 00173 FATAL = .TRUE. 00174 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN 00175 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS 00176 FATAL = .TRUE. 00177 END IF 00178 30 CONTINUE 00179 IF( NNS.GT.0 ) 00180 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) 00181 * 00182 * Read the matrix types 00183 * 00184 READ( NIN, FMT = * )NNT 00185 IF( NNT.LT.1 ) THEN 00186 WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1 00187 NNT = 0 00188 FATAL = .TRUE. 00189 ELSE IF( NNT.GT.NTYPES ) THEN 00190 WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES 00191 NNT = 0 00192 FATAL = .TRUE. 00193 END IF 00194 READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT ) 00195 DO 320 I = 1, NNT 00196 IF( NTVAL( I ).LT.0 ) THEN 00197 WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0 00198 FATAL = .TRUE. 00199 ELSE IF( NTVAL( I ).GT.NTYPES ) THEN 00200 WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES 00201 FATAL = .TRUE. 00202 END IF 00203 320 CONTINUE 00204 IF( NNT.GT.0 ) 00205 $ WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT ) 00206 * 00207 * Read the threshold value for the test ratios. 00208 * 00209 READ( NIN, FMT = * )THRESH 00210 WRITE( NOUT, FMT = 9992 )THRESH 00211 * 00212 * Read the flag that indicates whether to test the error exits. 00213 * 00214 READ( NIN, FMT = * )TSTERR 00215 * 00216 IF( FATAL ) THEN 00217 WRITE( NOUT, FMT = 9999 ) 00218 STOP 00219 END IF 00220 * 00221 IF( FATAL ) THEN 00222 WRITE( NOUT, FMT = 9999 ) 00223 STOP 00224 END IF 00225 * 00226 * Calculate and print the machine dependent constants. 00227 * 00228 EPS = DLAMCH( 'Underflow threshold' ) 00229 WRITE( NOUT, FMT = 9991 )'underflow', EPS 00230 EPS = DLAMCH( 'Overflow threshold' ) 00231 WRITE( NOUT, FMT = 9991 )'overflow ', EPS 00232 EPS = DLAMCH( 'Epsilon' ) 00233 WRITE( NOUT, FMT = 9991 )'precision', EPS 00234 WRITE( NOUT, FMT = * ) 00235 * 00236 * Test the error exit of: 00237 * 00238 IF( TSTERR ) 00239 $ CALL ZERRRFP( NOUT ) 00240 * 00241 * Test the routines: zpftrf, zpftri, zpftrs (as in ZDRVPO). 00242 * This also tests the routines: ztfsm, ztftri, ztfttr, ztrttf. 00243 * 00244 CALL ZDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, 00245 $ WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB, 00246 $ WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV, 00247 $ Z_WORK_ZLATMS, Z_WORK_ZPOT02, 00248 $ Z_WORK_ZPOT03, D_WORK_ZLATMS, D_WORK_ZLANHE, 00249 $ D_WORK_ZPOT01, D_WORK_ZPOT02, D_WORK_ZPOT03 ) 00250 * 00251 * Test the routine: zlanhf 00252 * 00253 CALL ZDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF, 00254 + D_WORK_ZLANHE ) 00255 * 00256 * Test the convertion routines: 00257 * zhfttp, ztpthf, ztfttr, ztrttf, ztrttp and ztpttr. 00258 * 00259 CALL ZDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF, 00260 + WORKAP, WORKASAV ) 00261 * 00262 * Test the routine: ztfsm 00263 * 00264 CALL ZDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF, 00265 + WORKAINV, WORKAFAC, D_WORK_ZLANHE, 00266 + Z_WORK_ZPOT03, Z_WORK_ZPOT02 ) 00267 00268 * 00269 * Test the routine: zhfrk 00270 * 00271 CALL ZDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX, 00272 + WORKARF, WORKAINV, NMAX,D_WORK_ZLANHE) 00273 * 00274 CLOSE ( NIN ) 00275 S2 = DSECND( ) 00276 WRITE( NOUT, FMT = 9998 ) 00277 WRITE( NOUT, FMT = 9997 )S2 - S1 00278 * 00279 9999 FORMAT( / ' Execution not attempted due to input errors' ) 00280 9998 FORMAT( / ' End of tests' ) 00281 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) 00282 9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=', 00283 $ I6 ) 00284 9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=', 00285 $ I6 ) 00286 9994 FORMAT( / ' Tests of the COMPLEX*16 LAPACK RFP routines ', 00287 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1, 00288 $ / / ' The following parameter values will be used:' ) 00289 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) 00290 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', 00291 $ 'less than', F8.2, / ) 00292 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) 00293 * 00294 * End of ZCHKRFP 00295 * 00296 END