1*DECK CDQCK 2 SUBROUTINE CDQCK (LUN, KPRINT, IPASS) 3C***BEGIN PROLOGUE CDQCK 4C***PURPOSE Quick check for SLATEC routines CDRIV1, CDRIV2 and CDRIV3. 5C***LIBRARY SLATEC (SDRIVE) 6C***CATEGORY I1A2, I1A1B 7C***TYPE COMPLEX (SDQCK-S, DDQCK-D, CDQCK-C) 8C***KEYWORDS CDRIV1, CDRIV2, CDRIV3, QUICK CHECK, SDRIVE 9C***AUTHOR Kahaner, D. K., (NIST) 10C National Institute of Standards and Technology 11C Gaithersburg, MD 20899 12C Sutherland, C. D., (LANL) 13C Mail Stop D466 14C Los Alamos National Laboratory 15C Los Alamos, NM 87545 16C***DESCRIPTION 17C 18C For assistance in determining the cause of a failure of these 19C routines contact C. D. Sutherland at commercial telephone number 20C (505)667-6949, FTS telephone number 8-843-6949, or electronic mail 21C address CDS@LANL.GOV . 22C 23C***ROUTINES CALLED CDF, CDRIV1, CDRIV2, CDRIV3, R1MACH, XERCLR 24C***REVISION HISTORY (YYMMDD) 25C 890405 DATE WRITTEN 26C 890405 Revised to meet SLATEC standards. 27C***END PROLOGUE CDQCK 28 EXTERNAL CDF 29 REAL EPS, EWT(1), HMAX, R1MACH, T, TOUT 30 INTEGER IERFLG, IERROR, IMPL, IPASS, KPRINT, LENIW, LENIWX, LENW, 31 8 LENWMX, LENWX, LIWMX, LUN, MINT, MITER, ML, MSTATE, MU, 32 8 MXORD, MXSTEP, N, NDE, NFE, NJE, NROOT, NSTATE, NSTEP, 33 8 NTASK, NX 34 PARAMETER(HMAX = 15.E0, IERROR = 3, IMPL = 0, 35 8 LENWMX = 342, LIWMX = 53, MITER = 5, ML = 2, MU = 2, 36 8 MXORD = 5, MXSTEP = 1000, N = 3, NROOT = 0, NTASK = 1) 37 COMPLEX ALFA, WORK(LENWMX), Y(N+1) 38 INTEGER IWORK(LIWMX) 39 DATA EWT(1) /.00001E0/ 40C***FIRST EXECUTABLE STATEMENT CDQCK 41 ALFA = (1.E0, 1.E0) 42 EPS = R1MACH(4)**(1.E0/3.E0) 43 IPASS = 1 44C Exercise CDRIV1 for problem 45C with known solution. 46 Y(4) = ALFA 47 T = 0.E0 48 Y(1) = 10.E0 49 Y(2) = 0.E0 50 Y(3) = 10.E0 51 TOUT = 10.E0 52 MSTATE = 1 53 LENW = 342 54 CALL CDRIV1 (N, T, Y, CDF, TOUT, MSTATE, EPS, WORK, LENW, IERFLG) 55 NSTEP = WORK(LENW - (N + 50) + 3) 56 NFE = WORK(LENW - (N + 50) + 4) 57 NJE = WORK(LENW - (N + 50) + 5) 58 IF (MSTATE .EQ. 2) THEN 59 IF (ABS(0.620174E0 - ABS(Y(1))) .LE. EPS**(2.E0/3.E0) .AND. 60 8 ABS(0.392232E0 - ABS(Y(2))) .LE. EPS**(2.E0/3.E0) .AND. 61 8 ABS(1.E0 - ABS(Y(3))) .LE. EPS**(2.E0/3.E0)) THEN 62 IF (KPRINT .EQ. 2) THEN 63 WRITE(LUN, '('' CDRIV1:The solution determined met '', 64 8 ''the expected values.'' //)') 65 ELSE IF (KPRINT .EQ. 3) THEN 66 WRITE(LUN, '('' CDRIV1:The solution determined met '', 67 8 ''the expected values.'')') 68 WRITE(LUN, '('' The values of results are '')') 69 WRITE(LUN, *) ' T ', T 70 WRITE(LUN, *) ' Y(1) ', Y(1) 71 WRITE(LUN, *) ' Y(2) ', Y(2) 72 WRITE(LUN, *) ' Y(3) ', Y(3) 73 WRITE(LUN, '(/)') 74 END IF 75 ELSE 76 IF (KPRINT .EQ. 1) THEN 77 WRITE(LUN, '('' CDRIV1:The solution determined is not '', 78 8 ''accurate enough.'' //)') 79 ELSE IF (KPRINT .EQ. 2) THEN 80 WRITE(LUN, '('' CDRIV1:The solution determined is not '', 81 8 ''accurate enough.'')') 82 WRITE(LUN, '('' The values of parameters, results, and '', 83 8 ''statistical quantities are:'')') 84 WRITE(LUN, *) ' EPS = ', EPS 85 WRITE(LUN, *) ' T ', T 86 WRITE(LUN, *) ' Y(1) ', Y(1) 87 WRITE(LUN, *) ' Y(2) ', Y(2) 88 WRITE(LUN, *) ' Y(3) ', Y(3) 89 WRITE(LUN, *) 90 8 ' Number of steps taken is ', NSTEP 91 WRITE(LUN, *) 92 8 ' Number of evaluations of the right hand side is ', NFE 93 WRITE(LUN, *) 94 8 ' Number of evaluations of the Jacobian matrix is ', NJE 95 WRITE(LUN, '(/)') 96 END IF 97 IPASS = 0 98 END IF 99 ELSE 100 IF (KPRINT .EQ. 1) THEN 101 WRITE(LUN, '('' While using CDRIV1, a solution was not '', 102 8 ''obtained.'' //)') 103 ELSE IF (KPRINT .GE. 2) THEN 104 WRITE(LUN, '('' While using CDRIV1, a solution was not '', 105 8 ''obtained.'')') 106 WRITE(LUN, '('' The values of parameters, results, and '', 107 8 ''statistical quantities are:'')') 108 WRITE(LUN, *) 109 8 ' MSTATE = ', MSTATE, ', Error number = ', IERFLG 110 WRITE(LUN, *) ' N ', N, ', EPS ', EPS, ', LENW ', LENW 111 WRITE(LUN, *) ' T ', T 112 WRITE(LUN, *) ' Y(1) ', Y(1) 113 WRITE(LUN, *) ' Y(2) ', Y(2) 114 WRITE(LUN, *) ' Y(3) ', Y(3) 115 WRITE(LUN, *) 116 8 ' Number of steps taken is ', NSTEP 117 WRITE(LUN, *) 118 8 ' Number of evaluations of the right hand side is ', NFE 119 WRITE(LUN, *) 120 8 ' Number of evaluations of the Jacobian matrix is ', NJE 121 WRITE(LUN, '(/)') 122 END IF 123 IPASS = 0 124 END IF 125 CALL XERCLR 126C Run CDRIV1 with invalid input. 127 NX = 201 128 T = 0.E0 129 Y(1) = 10.E0 130 Y(2) = 0.E0 131 Y(3) = 10.E0 132 Y(4) = ALFA 133 TOUT = 10.E0 134 MSTATE = 1 135 LENW = 342 136 CALL CDRIV1 (NX, T, Y, CDF, TOUT, MSTATE, EPS, WORK, LENW, IERFLG) 137 IF (IERFLG .EQ. 21) THEN 138 IF (KPRINT .EQ. 2) THEN 139 WRITE(LUN, '('' CDRIV1:An invalid parameter has been '', 140 8 ''correctly detected.'' //)') 141 ELSE IF (KPRINT .EQ. 3) THEN 142 WRITE(LUN, '('' CDRIV1:An invalid parameter has been '', 143 8 ''correctly detected.'')') 144 WRITE(LUN, *) ' The value of N was set to ', NX 145 WRITE(LUN, *) 146 8 ' MSTATE = ', MSTATE, ', Error number = ', IERFLG 147 WRITE(LUN, '(/)') 148 END IF 149 ELSE 150 IF (KPRINT .EQ. 1) THEN 151 WRITE(LUN, '('' CDRIV1:An invalid parameter has not '', 152 8 ''been correctly detected.'' //)') 153 ELSE IF (KPRINT .GE. 2) THEN 154 WRITE(LUN, '('' CDRIV1:An invalid parameter has not '', 155 8 ''been correctly detected.'')') 156 WRITE(LUN, *) ' The value of N was set to ', NX 157 WRITE(LUN, *) 158 8 ' MSTATE = ', MSTATE, ', Error number = ', IERFLG 159 WRITE(LUN, '('' The values of parameters, results, and '', 160 8 ''statistical quantities are:'')') 161 WRITE(LUN, *) ' EPS ', EPS, ', LENW ', LENW 162 WRITE(LUN, *) ' T ', T 163 WRITE(LUN, *) ' Y(1) ', Y(1) 164 WRITE(LUN, *) ' Y(2) ', Y(2) 165 WRITE(LUN, *) ' Y(3) ', Y(3) 166 WRITE(LUN, *) 167 8 ' Number of steps taken is ', NSTEP 168 WRITE(LUN, *) 169 8 ' Number of evaluations of the right hand side is ', NFE 170 WRITE(LUN, *) 171 8 ' Number of evaluations of the Jacobian matrix is ', NJE 172 WRITE(LUN, '(/)') 173 END IF 174 IPASS = 0 175 END IF 176 CALL XERCLR 177C Exercise CDRIV2 for problem 178C with known solution. 179 T = 0.E0 180 Y(1) = 10.E0 181 Y(2) = 0.E0 182 Y(3) = 10.E0 183 Y(4) = ALFA 184 MSTATE = 1 185 TOUT = 10.E0 186 MINT = 1 187 LENW = 298 188 LENIW = 50 189 CALL CDRIV2 (N, T, Y, CDF, TOUT, MSTATE, NROOT, EPS, EWT, 190 8 MINT, WORK, LENW, IWORK, LENIW, CDF, IERFLG) 191 NSTEP = IWORK(3) 192 NFE = IWORK(4) 193 NJE = IWORK(5) 194 IF (MSTATE .EQ. 2) THEN 195 IF (ABS(0.620174E0 - ABS(Y(1))) .LE. EPS**(2.E0/3.E0) .AND. 196 8 ABS(0.392232E0 - ABS(Y(2))) .LE. EPS**(2.E0/3.E0) .AND. 197 8 ABS(1.E0 - ABS(Y(3))) .LE. EPS**(2.E0/3.E0)) THEN 198 IF (KPRINT .EQ. 2) THEN 199 WRITE(LUN, '('' CDRIV2:The solution determined met '', 200 8 ''the expected values.'' //)') 201 ELSE IF (KPRINT .EQ. 3) THEN 202 WRITE(LUN, '('' CDRIV2:The solution determined met '', 203 8 ''the expected values.'')') 204 WRITE(LUN, '('' The values of results are '')') 205 WRITE(LUN, *) ' T ', T 206 WRITE(LUN, *) ' Y(1) ', Y(1) 207 WRITE(LUN, *) ' Y(2) ', Y(2) 208 WRITE(LUN, *) ' Y(3) ', Y(3) 209 WRITE(LUN, '(/)') 210 END IF 211 ELSE 212 IF (KPRINT .EQ. 1) THEN 213 WRITE(LUN, '('' CDRIV2:The solution determined is not '', 214 8 ''accurate enough. //'')') 215 ELSE IF (KPRINT .EQ. 2) THEN 216 WRITE(LUN, '('' CDRIV2:The solution determined is not '', 217 8 ''accurate enough.'')') 218 WRITE(LUN, '('' The values of parameters, results, and '', 219 8 ''statistical quantities are:'')') 220 WRITE(LUN, *) ' EPS = ', EPS, ', EWT = ', EWT 221 WRITE(LUN, *) ' T ', T 222 WRITE(LUN, *) ' Y(1) ', Y(1) 223 WRITE(LUN, *) ' Y(2) ', Y(2) 224 WRITE(LUN, *) ' Y(3) ', Y(3) 225 WRITE(LUN, *) 226 8 ' Number of steps taken is ', NSTEP 227 WRITE(LUN, *) 228 8 ' Number of evaluations of the right hand side is ', NFE 229 WRITE(LUN, *) 230 8 ' Number of evaluations of the Jacobian matrix is ', NJE 231 WRITE(LUN, '(/)') 232 END IF 233 IPASS = 0 234 END IF 235 ELSE 236 IF (KPRINT .EQ. 1) THEN 237 WRITE(LUN, '('' While using CDRIV2, a solution was not '', 238 8 ''obtained.'' //)') 239 ELSE IF (KPRINT .GE. 2) THEN 240 WRITE(LUN, '('' While using CDRIV2, a solution was not '', 241 8 ''obtained.'')') 242 WRITE(LUN, *) 243 8 ' MSTATE = ', MSTATE, ', Error number = ', IERFLG 244 WRITE(LUN, '('' The values of parameters, results, and '', 245 8 ''statistical quantities are:'')') 246 WRITE(LUN, *) ' EPS = ', EPS, ', EWT ', EWT 247 WRITE(LUN, *) 248 8 ' MINT = ', MINT, ', LENW ', LENW, ', LENIW ', LENIW 249 WRITE(LUN, *) ' T ', T 250 WRITE(LUN, *) ' Y(1) ', Y(1) 251 WRITE(LUN, *) ' Y(2) ', Y(2) 252 WRITE(LUN, *) ' Y(3) ', Y(3) 253 WRITE(LUN, *) 254 8 ' Number of steps taken is ', NSTEP 255 WRITE(LUN, *) 256 8 ' Number of evaluations of the right hand side is ', NFE 257 WRITE(LUN, *) 258 8 ' Number of evaluations of the Jacobian matrix is ', NJE 259 WRITE(LUN, '(/)') 260 END IF 261 IPASS = 0 262 END IF 263 CALL XERCLR 264C Run CDRIV2 with invalid input. 265 T = 0.E0 266 Y(1) = 10.E0 267 Y(2) = 0.E0 268 Y(3) = 10.E0 269 Y(4) = ALFA 270 TOUT = 10.E0 271 MSTATE = 1 272 MINT = 1 273 LENWX = 1 274 LENIW = 50 275 CALL CDRIV2 (N, T, Y, CDF, TOUT, MSTATE, NROOT, EPS, EWT, 276 8 MINT, WORK, LENWX, IWORK, LENIW, CDF, IERFLG) 277 IF (IERFLG .EQ. 32) THEN 278 IF (KPRINT .EQ. 2) THEN 279 WRITE(LUN, '('' CDRIV2:An invalid parameter has been '', 280 8 ''correctly detected.'' //)') 281 ELSE IF (KPRINT .EQ. 3) THEN 282 WRITE(LUN, '('' CDRIV2:An invalid parameter has been '', 283 8 ''correctly detected.'')') 284 WRITE(LUN, *) 285 8 ' The value of LENW was set to ', LENWX 286 WRITE(LUN, *) 287 8 ' MSTATE = ', MSTATE, ', Error number = ', IERFLG 288 WRITE(LUN, '(/)') 289 END IF 290 ELSE 291 IF (KPRINT .EQ. 1) THEN 292 WRITE(LUN, '('' CDRIV2:An invalid parameter has not '', 293 8 ''been correctly detected.'' //)') 294 ELSE IF (KPRINT .GE. 2) THEN 295 WRITE(LUN, '('' CDRIV2:An invalid parameter has not '', 296 8 ''been correctly detected.'')') 297 WRITE(LUN, *) ' The value of LENW was set to ', LENWX 298 WRITE(LUN, *) 299 8 ' MSTATE = ', MSTATE, ', Error number = ', IERFLG 300 WRITE(LUN, '('' The values of parameters, results, and '', 301 8 ''statistical quantities are:'')') 302 WRITE(LUN, *) 303 8 ' EPS ', EPS, ', MINT ', MINT, ', LENW ', LENW, 304 8 ', LENIW ', LENIW 305 WRITE(LUN, *) ' T ', T 306 WRITE(LUN, *) ' Y(1) ', Y(1) 307 WRITE(LUN, *) ' Y(2) ', Y(2) 308 WRITE(LUN, *) ' Y(3) ', Y(3) 309 WRITE(LUN, *) 310 8 ' Number of steps taken is ', NSTEP 311 WRITE(LUN, *) 312 8 ' Number of evaluations of the right hand side is ', NFE 313 WRITE(LUN, *) 314 8 ' Number of evaluations of the Jacobian matrix is ', NJE 315 WRITE(LUN, '(/)') 316 END IF 317 IPASS = 0 318 END IF 319 CALL XERCLR 320C Exercise CDRIV3 for problem 321C with known solution. 322 T = 0.E0 323 Y(1) = 10.E0 324 Y(2) = 0.E0 325 Y(3) = 10.E0 326 Y(4) = ALFA 327 NSTATE = 1 328 TOUT = 10.E0 329 MINT = 2 330 LENW = 301 331 LENIW = 53 332 CALL CDRIV3 (N, T, Y, CDF, NSTATE, TOUT, NTASK, NROOT, EPS, EWT, 333 8 IERROR, MINT, MITER, IMPL, ML, MU, MXORD, HMAX, 334 8 WORK, LENW, IWORK, LENIW, CDF, CDF, NDE, 335 8 MXSTEP, CDF, CDF, IERFLG) 336 NSTEP = IWORK(3) 337 NFE = IWORK(4) 338 NJE = IWORK(5) 339 IF (NSTATE .EQ. 2) THEN 340 IF (ABS(0.620174E0 - ABS(Y(1))) .LE. EPS**(2.E0/3.E0) .AND. 341 8 ABS(0.392232E0 - ABS(Y(2))) .LE. EPS**(2.E0/3.E0) .AND. 342 8 ABS(1.E0 - ABS(Y(3))) .LE. EPS**(2.E0/3.E0)) THEN 343 IF (KPRINT .EQ. 2) THEN 344 WRITE(LUN, '('' CDRIV3:The solution determined met '', 345 8 ''the expected values.'' //)') 346 ELSE IF (KPRINT .EQ. 3) THEN 347 WRITE(LUN, '('' CDRIV3:The solution determined met '', 348 8 ''the expected values.'')') 349 WRITE(LUN, '('' The values of results are '')') 350 WRITE(LUN, *) ' T ', T 351 WRITE(LUN, *) ' Y(1) ', Y(1) 352 WRITE(LUN, *) ' Y(2) ', Y(2) 353 WRITE(LUN, *) ' Y(3) ', Y(3) 354 WRITE(LUN, '(/)') 355 END IF 356 ELSE 357 IF (KPRINT .EQ. 1) THEN 358 WRITE(LUN, '('' CDRIV3:The solution determined is not '', 359 8 ''accurate enough.'' //)') 360 ELSE IF (KPRINT .GE. 2) THEN 361 WRITE(LUN, '('' CDRIV3:The solution determined is not '', 362 8 ''accurate enough.'')') 363 WRITE(LUN, '('' The values of parameters, results, and '', 364 8 ''statistical quantities are:'')') 365 WRITE(LUN, *) 366 8 ' EPS = ', EPS, ', EWT = ', EWT, ', IERROR = ', IERROR 367 WRITE(LUN, *) 368 8 ' MINT = ', MINT, ', MITER = ', MITER, ', IMPL = ', IMPL 369 WRITE(LUN, *) ' T ', T 370 WRITE(LUN, *) ' Y(1) ', Y(1) 371 WRITE(LUN, *) ' Y(2) ', Y(2) 372 WRITE(LUN, *) ' Y(3) ', Y(3) 373 WRITE(LUN, *) 374 8 ' Number of steps taken is ', NSTEP 375 WRITE(LUN, *) 376 8 ' Number of evaluations of the right hand side is ', NFE 377 WRITE(LUN, *) 378 8 ' Number of evaluations of the Jacobian matrix is ', NJE 379 WRITE(LUN, '(/)') 380 END IF 381 IPASS = 0 382 END IF 383 ELSE 384 IF (KPRINT .EQ. 1) THEN 385 WRITE(LUN, '('' While using CDRIV3, a solution was not '', 386 8 ''obtained.'' //)') 387 ELSE IF (KPRINT .GE. 2) THEN 388 WRITE(LUN, '('' While using CDRIV3, a solution was not '', 389 8 ''obtained.'')') 390 WRITE(LUN, *) 391 8 ' MSTATE = ', MSTATE, ', Error number = ', IERFLG 392 WRITE(LUN, '('' The values of parameters, results, and '', 393 8 ''statistical quantities are:'')') 394 WRITE(LUN, *) 395 8 ' EPS = ', EPS, ', EWT = ', EWT, ', IERROR = ', IERROR 396 WRITE(LUN, *) 397 8 ' MINT = ', MINT, ', MITER = ', MITER, ', IMPL = ', IMPL 398 WRITE(LUN, *) ' T ', T 399 WRITE(LUN, *) ' Y(1) ', Y(1) 400 WRITE(LUN, *) ' Y(2) ', Y(2) 401 WRITE(LUN, *) ' Y(3) ', Y(3) 402 WRITE(LUN, *) 403 8 ' Number of steps taken is ', NSTEP 404 WRITE(LUN, *) 405 8 ' Number of evaluations of the right hand side is ', NFE 406 WRITE(LUN, *) 407 8 ' Number of evaluations of the Jacobian matrix is ', NJE 408 WRITE(LUN, '(/)') 409 END IF 410 IPASS = 0 411 END IF 412 CALL XERCLR 413C Run CDRIV3 with invalid input. 414 T = 0.E0 415 Y(1) = 10.E0 416 Y(2) = 0.E0 417 Y(3) = 10.E0 418 Y(4) = ALFA 419 NSTATE = 1 420 TOUT = 10.E0 421 MINT = 2 422 LENW = 301 423 LENIWX = 1 424 CALL CDRIV3 (N, T, Y, CDF, NSTATE, TOUT, NTASK, NROOT, EPS, 425 8 EWT, IERROR, MINT, MITER, IMPL, ML, MU, 426 8 MXORD, HMAX, WORK, LENW, IWORK, LENIWX, CDF, 427 8 CDF, NDE, MXSTEP, CDF, CDF, IERFLG) 428 IF (IERFLG .EQ. 33) THEN 429 IF (KPRINT .EQ. 2) THEN 430 WRITE(LUN, '('' CDRIV3:An invalid parameter has been '', 431 8 ''correctly detected.'' //)') 432 ELSE IF (KPRINT .EQ. 3) THEN 433 WRITE(LUN, '('' CDRIV3:An invalid parameter has been '', 434 8 ''correctly detected.'')') 435 WRITE(LUN, *) 436 8 ' The value of LENIW was set to ', LENIWX 437 WRITE(LUN, *) 438 8 ' NSTATE = ', NSTATE, ', Error number = ', IERFLG 439 WRITE(LUN, '(/)') 440 END IF 441 ELSE 442 IF (KPRINT .EQ. 1) THEN 443 WRITE(LUN, '('' CDRIV3:An invalid parameter has not '', 444 8 ''been correctly detected.'' //)') 445 ELSE IF (KPRINT .GE. 2) THEN 446 WRITE(LUN, '('' CDRIV3:An invalid parameter has not '', 447 8 ''been correctly detected.'')') 448 WRITE(LUN, *) 449 8 ' The value of LENIW was set to ', LENIWX 450 WRITE(LUN, *) 451 8 ' NSTATE = ', NSTATE, ', Error number = ', IERFLG 452 WRITE(LUN, '('' The values of parameters, results, and '', 453 8 ''statistical quantities are:'')') 454 WRITE(LUN, *) 455 8 ' EPS = ', EPS, ', EWT = ', EWT, ', IERROR = ', IERROR 456 WRITE(LUN, *) 457 8 ' MINT = ', MINT, ', MITER = ', MITER, ', IMPL = ', IMPL 458 WRITE(LUN, *) ' T ', T 459 WRITE(LUN, *) ' Y(1) ', Y(1) 460 WRITE(LUN, *) ' Y(2) ', Y(2) 461 WRITE(LUN, *) ' Y(3) ', Y(3) 462 WRITE(LUN, *) 463 8 ' Number of steps taken is ', NSTEP 464 WRITE(LUN, *) 465 8 ' Number of evaluations of the right hand side is ', NFE 466 WRITE(LUN, *) 467 8 ' Number of evaluations of the Jacobian matrix is ', NJE 468 WRITE(LUN, '(/)') 469 END IF 470 IPASS = 0 471 END IF 472 CALL XERCLR 473 RETURN 474 END 475