 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 PROGRAM ZCHKAB 00002 IMPLICIT NONE 00003 * 00004 * -- LAPACK test routine (version 3.2.1) -- 00005 * 00006 * -- April 2009 -- 00007 * 00008 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00009 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * ZCHKAB is the test program for the COMPLEX*16 LAPACK 00015 * ZCGESV/ZCPOSV routine 00016 * 00017 * The program must be driven by a short data file. The first 5 records 00018 * specify problem dimensions and program options using list-directed 00019 * input. The remaining lines specify the LAPACK test paths and the 00020 * number of matrix types to use in testing. An annotated example of a 00021 * data file can be obtained by deleting the first 3 characters from the 00022 * following 9 lines: 00023 * Data file for testing COMPLEX*16 LAPACK ZCGESV 00024 * 7 Number of values of M 00025 * 0 1 2 3 5 10 16 Values of M (row dimension) 00026 * 1 Number of values of NRHS 00027 * 2 Values of NRHS (number of right hand sides) 00028 * 20.0 Threshold value of test ratio 00029 * T Put T to test the LAPACK routine 00030 * T Put T to test the error exits 00031 * DGE 11 List types on next line if 0 < NTYPES < 11 00032 * DPO 9 List types on next line if 0 < NTYPES < 9 00033 * 00034 * Internal Parameters 00035 * =================== 00036 * 00037 * NMAX INTEGER 00038 * The maximum allowable value for N 00039 * 00040 * MAXIN INTEGER 00041 * The number of different values that can be used for each of 00042 * M, N, NRHS, NB, and NX 00043 * 00044 * MAXRHS INTEGER 00045 * The maximum number of right hand sides 00046 * 00047 * NIN INTEGER 00048 * The unit number for input 00049 * 00050 * NOUT INTEGER 00051 * The unit number for output 00052 * 00053 * ===================================================================== 00054 * 00055 * .. Parameters .. 00056 INTEGER NMAX 00057 PARAMETER ( NMAX = 132 ) 00058 INTEGER MAXIN 00059 PARAMETER ( MAXIN = 12 ) 00060 INTEGER MAXRHS 00061 PARAMETER ( MAXRHS = 16 ) 00062 INTEGER MATMAX 00063 PARAMETER ( MATMAX = 30 ) 00064 INTEGER NIN, NOUT 00065 PARAMETER ( NIN = 5, NOUT = 6 ) 00066 INTEGER LDAMAX 00067 PARAMETER ( LDAMAX = NMAX ) 00068 * .. 00069 * .. Local Scalars .. 00070 LOGICAL FATAL, TSTDRV, TSTERR 00071 CHARACTER C1 00072 CHARACTER*2 C2 00073 CHARACTER*3 PATH 00074 CHARACTER*10 INTSTR 00075 CHARACTER*72 ALINE 00076 INTEGER I, IC, K, LDA, NM, NMATS, 00077 $ NNS, NRHS, NTYPES, 00078 $ VERS_MAJOR, VERS_MINOR, VERS_PATCH 00079 DOUBLE PRECISION EPS, S1, S2, THRESH 00080 REAL SEPS 00081 * .. 00082 * .. Local Arrays .. 00083 LOGICAL DOTYPE( MATMAX ) 00084 INTEGER IWORK( NMAX ), MVAL( MAXIN ), NSVAL( MAXIN ) 00085 DOUBLE PRECISION RWORK(NMAX) 00086 COMPLEX*16 A( LDAMAX*NMAX, 2 ), B( NMAX*MAXRHS, 2 ), 00087 $ WORK( NMAX*MAXRHS*2 ) 00088 COMPLEX SWORK(NMAX*(NMAX+MAXRHS)) 00089 * .. 00090 * .. External Functions .. 00091 DOUBLE PRECISION DLAMCH, DSECND 00092 LOGICAL LSAME, LSAMEN 00093 REAL SLAMCH 00094 EXTERNAL DLAMCH, DSECND, LSAME, LSAMEN, SLAMCH 00095 * .. 00096 * .. External Subroutines .. 00097 EXTERNAL ALAREQ, ZDRVAB, ZDRVAC, ZERRAB, ZERRAC, 00098 $ ILAVER 00099 * .. 00100 * .. Scalars in Common .. 00101 LOGICAL LERR, OK 00102 CHARACTER*32 SRNAMT 00103 INTEGER INFOT, NUNIT 00104 * .. 00105 * .. Common blocks .. 00106 COMMON / INFOC / INFOT, NUNIT, OK, LERR 00107 COMMON / SRNAMC / SRNAMT 00108 * 00109 * .. Data statements .. 00110 DATA INTSTR / '0123456789' / 00111 * .. 00112 * .. Executable Statements .. 00113 * 00114 S1 = DSECND( ) 00115 LDA = NMAX 00116 FATAL = .FALSE. 00117 * 00118 * Read a dummy line. 00119 * 00120 READ( NIN, FMT = * ) 00121 * 00122 * Report values of parameters. 00123 * 00124 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) 00125 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH 00126 * 00127 * Read the values of M 00128 * 00129 READ( NIN, FMT = * )NM 00130 IF( NM.LT.1 ) THEN 00131 WRITE( NOUT, FMT = 9996 )' NM ', NM, 1 00132 NM = 0 00133 FATAL = .TRUE. 00134 ELSE IF( NM.GT.MAXIN ) THEN 00135 WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN 00136 NM = 0 00137 FATAL = .TRUE. 00138 END IF 00139 READ( NIN, FMT = * )( MVAL( I ), I = 1, NM ) 00140 DO 10 I = 1, NM 00141 IF( MVAL( I ).LT.0 ) THEN 00142 WRITE( NOUT, FMT = 9996 )' M ', MVAL( I ), 0 00143 FATAL = .TRUE. 00144 ELSE IF( MVAL( I ).GT.NMAX ) THEN 00145 WRITE( NOUT, FMT = 9995 )' M ', MVAL( I ), NMAX 00146 FATAL = .TRUE. 00147 END IF 00148 10 CONTINUE 00149 IF( NM.GT.0 ) 00150 $ WRITE( NOUT, FMT = 9993 )'M ', ( MVAL( I ), I = 1, NM ) 00151 * 00152 * Read the values of NRHS 00153 * 00154 READ( NIN, FMT = * )NNS 00155 IF( NNS.LT.1 ) THEN 00156 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 00157 NNS = 0 00158 FATAL = .TRUE. 00159 ELSE IF( NNS.GT.MAXIN ) THEN 00160 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN 00161 NNS = 0 00162 FATAL = .TRUE. 00163 END IF 00164 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) 00165 DO 30 I = 1, NNS 00166 IF( NSVAL( I ).LT.0 ) THEN 00167 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 00168 FATAL = .TRUE. 00169 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN 00170 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS 00171 FATAL = .TRUE. 00172 END IF 00173 30 CONTINUE 00174 IF( NNS.GT.0 ) 00175 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) 00176 * 00177 * Read the threshold value for the test ratios. 00178 * 00179 READ( NIN, FMT = * )THRESH 00180 WRITE( NOUT, FMT = 9992 )THRESH 00181 * 00182 * Read the flag that indicates whether to test the driver routine. 00183 * 00184 READ( NIN, FMT = * )TSTDRV 00185 * 00186 * Read the flag that indicates whether to test the error exits. 00187 * 00188 READ( NIN, FMT = * )TSTERR 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 SEPS = SLAMCH( 'Underflow threshold' ) 00198 WRITE( NOUT, FMT = 9991 )'(single precision) underflow', SEPS 00199 SEPS = SLAMCH( 'Overflow threshold' ) 00200 WRITE( NOUT, FMT = 9991 )'(single precision) overflow ', SEPS 00201 SEPS = SLAMCH( 'Epsilon' ) 00202 WRITE( NOUT, FMT = 9991 )'(single precision) precision', SEPS 00203 WRITE( NOUT, FMT = * ) 00204 * 00205 EPS = DLAMCH( 'Underflow threshold' ) 00206 WRITE( NOUT, FMT = 9991 )'(double precision) underflow', EPS 00207 EPS = DLAMCH( 'Overflow threshold' ) 00208 WRITE( NOUT, FMT = 9991 )'(double precision) overflow ', EPS 00209 EPS = DLAMCH( 'Epsilon' ) 00210 WRITE( NOUT, FMT = 9991 )'(double precision) precision', EPS 00211 WRITE( NOUT, FMT = * ) 00212 * 00213 80 CONTINUE 00214 * 00215 * Read a test path and the number of matrix types to use. 00216 * 00217 READ( NIN, FMT = '(A72)', END = 140 )ALINE 00218 PATH = ALINE( 1: 3 ) 00219 NMATS = MATMAX 00220 I = 3 00221 90 CONTINUE 00222 I = I + 1 00223 IF( I.GT.72 ) THEN 00224 NMATS = MATMAX 00225 GO TO 130 00226 END IF 00227 IF( ALINE( I: I ).EQ.' ' ) 00228 $ GO TO 90 00229 NMATS = 0 00230 100 CONTINUE 00231 C1 = ALINE( I: I ) 00232 DO 110 K = 1, 10 00233 IF( C1.EQ.INTSTR( K: K ) ) THEN 00234 IC = K - 1 00235 GO TO 120 00236 END IF 00237 110 CONTINUE 00238 GO TO 130 00239 120 CONTINUE 00240 NMATS = NMATS*10 + IC 00241 I = I + 1 00242 IF( I.GT.72 ) 00243 $ GO TO 130 00244 GO TO 100 00245 130 CONTINUE 00246 C1 = PATH( 1: 1 ) 00247 C2 = PATH( 2: 3 ) 00248 NRHS = NSVAL( 1 ) 00249 NRHS = NSVAL( 1 ) 00250 * 00251 * Check first character for correct precision. 00252 * 00253 IF( .NOT.LSAME( C1, 'Zomplex precision' ) ) THEN 00254 WRITE( NOUT, FMT = 9990 )PATH 00255 * 00256 ELSE IF( NMATS.LE.0 ) THEN 00257 * 00258 * Check for a positive number of tests requested. 00259 * 00260 WRITE( NOUT, FMT = 9990 )'ZCGESV' 00261 GO TO 140 00262 * 00263 ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN 00264 * 00265 * GE: general matrices 00266 * 00267 NTYPES = 11 00268 CALL ALAREQ( 'ZGE', NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00269 * 00270 * Test the error exits 00271 * 00272 IF( TSTERR ) 00273 $ CALL ZERRAB( NOUT ) 00274 * 00275 IF( TSTDRV ) THEN 00276 CALL ZDRVAB( DOTYPE, NM, MVAL, NNS, 00277 $ NSVAL, THRESH, LDA, A( 1, 1 ), 00278 $ A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), 00279 $ WORK, RWORK, SWORK, IWORK, NOUT ) 00280 ELSE 00281 WRITE( NOUT, FMT = 9989 )'ZCGESV' 00282 END IF 00283 * 00284 ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN 00285 * 00286 * PO: positive definite matrices 00287 * 00288 NTYPES = 9 00289 CALL ALAREQ( 'DPO', NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00290 * 00291 IF( TSTERR ) 00292 $ CALL ZERRAC( NOUT ) 00293 * 00294 * 00295 IF( TSTDRV ) THEN 00296 CALL ZDRVAC( DOTYPE, NM, MVAL, NNS, NSVAL, 00297 $ THRESH, LDA, A( 1, 1 ), A( 1, 2 ), 00298 $ B( 1, 1 ), B( 1, 2 ), 00299 $ WORK, RWORK, SWORK, NOUT ) 00300 ELSE 00301 WRITE( NOUT, FMT = 9989 )'ZCPOSV' 00302 END IF 00303 * 00304 ELSE 00305 * 00306 END IF 00307 * 00308 * Go back to get another input line. 00309 * 00310 GO TO 80 00311 * 00312 * Branch to this line when the last record is read. 00313 * 00314 140 CONTINUE 00315 CLOSE ( NIN ) 00316 S2 = DSECND( ) 00317 WRITE( NOUT, FMT = 9998 ) 00318 WRITE( NOUT, FMT = 9997 )S2 - S1 00319 * 00320 9999 FORMAT( / ' Execution not attempted due to input errors' ) 00321 9998 FORMAT( / ' End of tests' ) 00322 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) 00323 9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=', 00324 $ I6 ) 00325 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=', 00326 $ I6 ) 00327 9994 FORMAT( ' Tests of the COMPLEX*16 LAPACK ZCGESV/ZCPOSV routines ', 00328 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1, 00329 $ / / ' The following parameter values will be used:' ) 00330 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) 00331 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', 00332 $ 'less than', F8.2, / ) 00333 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) 00334 9990 FORMAT( / 1X, A6, ' routines were not tested' ) 00335 9989 FORMAT( / 1X, A6, ' driver routines were not tested' ) 00336 9988 FORMAT( / 1X, A3, ': Unrecognized path name' ) 00337 * 00338 * End of ZCHKAB 00339 * 00340 END
1.7.3 
