1c comment section 2c 3c fm099 4c 5c this routine tests various mathematical functions where both the 6c function type and arguments are real. the real variables and 7c constants contain both positive and negative values. the 8c functions tested in fm099 include 9c 10c type of 11c function name argument function 12c ---------------- ---- -------- -------- 13c exponential exp real real 14c natural logarithm alog real real 15c common logarithm alog10 real real 16c square root sqrt real real 17c trigonometric sine sin real real 18c trigonometric cosine cos real real 19c hyperbolic tangent tanh real real 20c arctangent atan real real 21c atan2 real real 22c 23c references 24c american national standard programming language fortran, 25c x3.9-1978 26c 27c section 8.7, external statement 28c section 15.5.2, function reference 29c 30c 31c ********************************************************** 32c 33c a compiler validation system for the fortran language 34c based on specifications as defined in american national standard 35c programming language fortran x3.9-1978, has been developed by the 36c federal cobol compiler testing service. the fortran compiler 37c validation system (fcvs) consists of audit routines, their related 38c data, and an executive system. each audit routine is a fortran 39c program, subprogram or function which includes tests of specific 40c language elements and supporting procedures indicating the result 41c of executing these tests. 42c 43c this particular program/subprogram/function contains features 44c found only in the subset as defined in x3.9-1978. 45c 46c suggestions and comments should be forwarded to - 47c 48c department of the navy 49c federal cobol compiler testing service 50c washington, d.c. 20376 51c 52c ********************************************************** 53c 54c 55c 56c initialization section 57c 58c initialize constants 59c ************** 60c i01 contains the logical unit number for the card reader. 61 i01 = 5 62c i02 contains the logical unit number for the printer. 63 i02 = 6 64c system environment section 65c 66cx010 this card is replaced by contents of fexec x-010 control card. 67c the cx010 card is for overriding the program default i01 = 5 68c (unit number for card reader). 69cx011 this card is replaced by contents of fexec x-011 control card. 70c the cx011 card is for systems which require additional 71c fortran statements for files associated with cx010 above. 72c 73cx020 this card is replaced by contents of fexec x-020 control card. 74c the cx020 card is for overriding the program default i02 = 6 75c (unit number for printer). 76cx021 this card is replaced by contents of fexec x-021 control card. 77c the cx021 card is for systems which require additional 78c fortran statements for files associated with cx020 above. 79c 80 ivpass=0 81 ivfail=0 82 ivdele=0 83 iczero=0 84c 85c write page headers 86 write (i02,90000) 87 write (i02,90001) 88 write (i02,90002) 89 write (i02, 90002) 90 write (i02,90003) 91 write (i02,90002) 92 write (i02,90004) 93 write (i02,90002) 94 write (i02,90011) 95 write (i02,90002) 96 write (i02,90002) 97 write (i02,90005) 98 write (i02,90006) 99 write (i02,90002) 100c 101c test section 102c 103c test 939 through test 942 contain function tests for exponential 104c functions where the argument and function are real 105c 106 ivtnum = 939 107c 108c **** test 939 **** 109c 110 if (iczero) 39390, 9390, 39390 111 9390 continue 112 rvon01 = 0.0 113 rvcomp = exp (rvon01) 114 go to 49390 11539390 ivdele = ivdele + 1 116 write (i02,80003) ivtnum 117 if (iczero) 49390, 9401, 49390 11849390 if (rvcomp - 0.95) 29390,19390,49391 11949391 if (rvcomp - 1.05) 19390,19390,29390 12019390 ivpass = ivpass + 1 121 write (i02,80001) ivtnum 122 go to 9401 12329390 ivfail = ivfail + 1 124 rvcorr = 1.00 125 write (i02,80005) ivtnum, rvcomp, rvcorr 126 9401 continue 127 ivtnum = 940 128c 129c **** test 940 **** 130c 131 if (iczero) 39400, 9400, 39400 132 9400 continue 133 rvcomp = exp (0.5) 134 go to 49400 13539400 ivdele = ivdele + 1 136 write (i02,80003) ivtnum 137 if (iczero) 49400, 9411, 49400 13849400 if (rvcomp - 1.60) 29400,19400,49401 13949401 if (rvcomp - 1.70) 19400,19400,29400 14019400 ivpass = ivpass + 1 141 write (i02,80001) ivtnum 142 go to 9411 14329400 ivfail = ivfail + 1 144 rvcorr = 1.65 145 write (i02,80005) ivtnum, rvcomp, rvcorr 146 9411 continue 147 ivtnum = 941 148c 149c **** test 941 **** 150c 151 if (iczero) 39410, 9410, 39410 152 9410 continue 153 rvon01 = .1e1 154 rvcomp = exp (rvon01) 155 go to 49410 15639410 ivdele = ivdele + 1 157 write (i02,80003) ivtnum 158 if (iczero) 49410, 9421, 49410 15949410 if (rvcomp - 2.67) 29410,19410,49411 16049411 if (rvcomp - 2.77) 19410,19410,29410 16119410 ivpass = ivpass + 1 162 write (i02,80001) ivtnum 163 go to 9421 16429410 ivfail = ivfail + 1 165 rvcorr = 2.72 166 write (i02,80005) ivtnum, rvcomp, rvcorr 167 9421 continue 168 ivtnum = 942 169c 170c **** test 942 **** 171c 172 if (iczero) 39420, 9420, 39420 173 9420 continue 174 rvon01 = -1.0 175 rvcomp = exp (rvon01) 176 go to 49420 17739420 ivdele = ivdele + 1 178 write (i02,80003) ivtnum 179 if (iczero) 49420, 9431, 49420 18049420 if (rvcomp - 0.363) 29420,19420,49421 18149421 if (rvcomp - 0.373) 19420,19420,29420 18219420 ivpass = ivpass + 1 183 write (i02,80001) ivtnum 184 go to 9431 18529420 ivfail = ivfail + 1 186 rvcorr = 0.368 187 write (i02,80005) ivtnum, rvcomp, rvcorr 188 9431 continue 189c 190c test 943 through test 945 contain function tests for natural 191c logarithm functions where the argument and function are real 192c 193 ivtnum = 943 194c 195c **** test 943 **** 196c 197 if (iczero) 39430, 9430, 39430 198 9430 continue 199 rvon01 = 5e1 200 rvcomp = alog (rvon01) 201 go to 49430 20239430 ivdele = ivdele + 1 203 write (i02,80003) ivtnum 204 if (iczero) 49430, 9441, 49430 20549430 if (rvcomp - 3.9115) 29430,19430,49431 20649431 if (rvcomp - 3.9125) 19430,19430,29430 20719430 ivpass = ivpass + 1 208 write (i02,80001) ivtnum 209 go to 9441 21029430 ivfail = ivfail + 1 211 rvcorr = 3.9120 212 write (i02,80005) ivtnum, rvcomp, rvcorr 213 9441 continue 214 ivtnum = 944 215c 216c **** test 944 **** 217c 218 if (iczero) 39440, 9440, 39440 219 9440 continue 220 rvon01 = 1.0 221 rvcomp = alog (rvon01) 222 go to 49440 22339440 ivdele = ivdele + 1 224 write (i02,80003) ivtnum 225 if (iczero) 49440, 9451, 49440 22649440 if (rvcomp + .00005) 29440,19440,49441 22749441 if (rvcomp - .00005) 19440,19440,29440 22819440 ivpass = ivpass + 1 229 write (i02,80001) ivtnum 230 go to 9451 23129440 ivfail = ivfail + 1 232 rvcorr = 0.00000 233 write (i02,80005) ivtnum, rvcomp, rvcorr 234 9451 continue 235 ivtnum = 945 236c 237c **** test 945 **** 238c 239 if (iczero) 39450, 9450, 39450 240 9450 continue 241 rvcomp = alog (2.0) 242 go to 49450 24339450 ivdele = ivdele + 1 244 write (i02,80003) ivtnum 245 if (iczero) 49450, 9461, 49450 24649450 if (rvcomp - 0.688) 29450,19450,49451 24749451 if (rvcomp - 0.698) 19450,19450,29450 24819450 ivpass = ivpass + 1 249 write (i02,80001) ivtnum 250 go to 9461 25129450 ivfail = ivfail + 1 252 rvcorr = 0.693 253 write (i02,80005) ivtnum, rvcomp, rvcorr 254 9461 continue 255c 256c test 946 through test 948 contain function tests for common 257c logarithm functions where the argument and function are real 258c 259 ivtnum = 946 260c 261c **** test 946 **** 262c 263 if (iczero) 39460, 9460, 39460 264 9460 continue 265 rvon01 = 2e2 266 rvcomp = alog10 (rvon01) 267 go to 49460 26839460 ivdele = ivdele + 1 269 write (i02,80003) ivtnum 270 if (iczero) 49460, 9471, 49460 27149460 if (rvcomp - 2.296) 29460,19460,49461 27249461 if (rvcomp - 2.306) 19460,19460,29460 27319460 ivpass = ivpass + 1 274 write (i02,80001) ivtnum 275 go to 9471 27629460 ivfail = ivfail + 1 277 rvcorr = 2.301 278 write (i02,80005) ivtnum, rvcomp, rvcorr 279 9471 continue 280 ivtnum = 947 281c 282c **** test 947 **** 283c 284 if (iczero) 39470, 9470, 39470 285 9470 continue 286 rvon01 = .3e+3 287 rvcomp = alog10 (rvon01) 288 go to 49470 28939470 ivdele = ivdele + 1 290 write (i02,80003) ivtnum 291 if (iczero) 49470, 9481, 49470 29249470 if (rvcomp - 2.472) 29470,19470,49471 29349471 if (rvcomp - 2.482) 19470,19470,29470 29419470 ivpass = ivpass + 1 295 write (i02,80001) ivtnum 296 go to 9481 29729470 ivfail = ivfail + 1 298 rvcorr = 2.477 299 write (i02,80005) ivtnum, rvcomp, rvcorr 300 9481 continue 301 ivtnum = 948 302c 303c **** test 948 **** 304c 305 if (iczero) 39480, 9480, 39480 306 9480 continue 307 rvon01 = 1350.0 308 rvcomp = alog10 (rvon01) 309 go to 49480 31039480 ivdele = ivdele + 1 311 write (i02,80003) ivtnum 312 if (iczero) 49480, 9491, 49480 31349480 if (rvcomp - 3.125) 29480,19480,49481 31449481 if (rvcomp - 3.135) 19480,19480,29480 31519480 ivpass = ivpass + 1 316 write (i02,80001) ivtnum 317 go to 9491 31829480 ivfail = ivfail + 1 319 rvcorr = 3.130 320 write (i02,80005) ivtnum, rvcomp, rvcorr 321 9491 continue 322c 323c test 949 through test 951 contain function tests for square root 324c functions where the argument and function are real 325c 326 ivtnum = 949 327c 328c **** test 949 **** 329c 330 if (iczero) 39490, 9490, 39490 331 9490 continue 332 rvon01 = 1.0 333 rvcomp = sqrt (rvon01) 334 go to 49490 33539490 ivdele = ivdele + 1 336 write (i02,80003) ivtnum 337 if (iczero) 49490, 9501, 49490 33849490 if (rvcomp - 0.95) 29490,19490,49491 33949491 if (rvcomp - 1.05) 19490,19490,29490 34019490 ivpass = ivpass + 1 341 write (i02,80001) ivtnum 342 go to 9501 34329490 ivfail = ivfail + 1 344 rvcorr = 1.00 345 write (i02,80005) ivtnum, rvcomp, rvcorr 346 9501 continue 347 ivtnum = 950 348c 349c **** test 950 **** 350c 351 if (iczero) 39500, 9500, 39500 352 9500 continue 353 rvcomp = sqrt (2.0) 354 go to 49500 35539500 ivdele = ivdele + 1 356 write (i02,80003) ivtnum 357 if (iczero) 49500, 9511, 49500 35849500 if (rvcomp - 1.36) 29500,19500,49501 35949501 if (rvcomp - 1.46) 19500,19500,29500 36019500 ivpass = ivpass + 1 361 write (i02,80001) ivtnum 362 go to 9511 36329500 ivfail = ivfail + 1 364 rvcorr = 1.41 365 write (i02,80005) ivtnum, rvcomp, rvcorr 366 9511 continue 367 ivtnum = 951 368c 369c **** test 951 **** 370c 371 if (iczero) 39510, 9510, 39510 372 9510 continue 373 rvon01 = .229e1 374 rvcomp = sqrt (rvon01) 375 go to 49510 37639510 ivdele = ivdele + 1 377 write (i02,80003) ivtnum 378 if (iczero) 49510, 9521, 49510 37949510 if (rvcomp - 1.46) 29510,19510,49511 38049511 if (rvcomp - 1.56) 19510,19510,29510 38119510 ivpass = ivpass + 1 382 write (i02,80001) ivtnum 383 go to 9521 38429510 ivfail = ivfail + 1 385 rvcorr = 1.51 386 write (i02,80005) ivtnum, rvcomp, rvcorr 387 9521 continue 388c 389c test 952 through test 953 contain function tests for trigonometric 390c sine functions where the argument and function are real 391c 392 ivtnum = 952 393c 394c **** test 952 **** 395c 396 if (iczero) 39520, 9520, 39520 397 9520 continue 398 rvon01 = 0.00000 399 rvcomp = sin (rvon01) 400 go to 49520 40139520 ivdele = ivdele + 1 402 write (i02,80003) ivtnum 403 if (iczero) 49520, 9531, 49520 40449520 if (rvcomp + .00005) 29520,19520,49521 40549521 if (rvcomp - .00005) 19520,19520,29520 40619520 ivpass = ivpass + 1 407 write (i02,80001) ivtnum 408 go to 9531 40929520 ivfail = ivfail + 1 410 rvcorr = 0.00000 411 write (i02,80005) ivtnum, rvcomp, rvcorr 412 9531 continue 413 ivtnum = 953 414c 415c **** test 953 **** 416c 417 if (iczero) 39530, 9530, 39530 418 9530 continue 419 rvon01 = 0.5 420 rvcomp = sin (rvon01) 421 go to 49530 42239530 ivdele = ivdele + 1 423 write (i02,80003) ivtnum 424 if (iczero) 49530, 9541, 49530 42549530 if (rvcomp - .474) 29530,19530,49531 42649531 if (rvcomp - .484) 19530,19530,29530 42719530 ivpass = ivpass + 1 428 write (i02,80001) ivtnum 429 go to 9541 43029530 ivfail = ivfail + 1 431 rvcorr = .479 432 write (i02,80005) ivtnum, rvcomp, rvcorr 433 9541 continue 434 ivtnum = 954 435c 436c **** test 954 **** 437c 438 if (iczero) 39540, 9540, 39540 439 9540 continue 440 rvon01 = 4e0 441 rvcomp = sin (rvon01) 442 go to 49540 44339540 ivdele = ivdele + 1 444 write (i02,80003) ivtnum 445 if (iczero) 49540, 9551, 49540 44649540 if (rvcomp + .762) 29540,19540,49541 44749541 if (rvcomp + .752) 19540,19540,29540 44819540 ivpass = ivpass + 1 449 write (i02,80001) ivtnum 450 go to 9551 45129540 ivfail = ivfail + 1 452 rvcorr = -.757 453 write (i02,80005) ivtnum, rvcomp, rvcorr 454 9551 continue 455c 456c test 955 through test 957 contain function tests for trigonometric 457c cosine functions where the argument and function are real 458c 459 ivtnum = 955 460c 461c **** test 955 **** 462c 463 if (iczero) 39550, 9550, 39550 464 9550 continue 465 rvon01 = 0.00000 466 rvcomp = cos (rvon01) 467 go to 49550 46839550 ivdele = ivdele + 1 469 write (i02,80003) ivtnum 470 if (iczero) 49550, 9561, 49550 47149550 if (rvcomp - .995) 29550,19550,49551 47249551 if (rvcomp - 1.005) 19550,19550,29550 47319550 ivpass = ivpass + 1 474 write (i02,80001) ivtnum 475 go to 9561 47629550 ivfail = ivfail + 1 477 rvcorr = 1.000 478 write (i02,80005) ivtnum, rvcomp, rvcorr 479 9561 continue 480 ivtnum = 956 481c 482c **** test 956 **** 483c 484 if (iczero) 39560, 9560, 39560 485 9560 continue 486 rvon01 = 1.0e0 487 rvcomp = cos (rvon01) 488 go to 49560 48939560 ivdele = ivdele + 1 490 write (i02,80003) ivtnum 491 if (iczero) 49560, 9571, 49560 49249560 if (rvcomp - .535) 29560,19560,49561 49349561 if (rvcomp - .545) 19560,19560,29560 49419560 ivpass = ivpass + 1 495 write (i02,80001) ivtnum 496 go to 9571 49729560 ivfail = ivfail + 1 498 rvcorr = 0.540 499 write (i02,80005) ivtnum, rvcomp, rvcorr 500 9571 continue 501 ivtnum = 957 502c 503c **** test 957 **** 504c 505 if (iczero) 39570, 9570, 39570 506 9570 continue 507 rvcomp = cos (4.0) 508 go to 49570 50939570 ivdele = ivdele + 1 510 write (i02,80003) ivtnum 511 if (iczero) 49570, 9581, 49570 51249570 if (rvcomp + .659) 29570,19570,49571 51349571 if (rvcomp + .649) 19570,19570,29570 51419570 ivpass = ivpass + 1 515 write (i02,80001) ivtnum 516 go to 9581 51729570 ivfail = ivfail + 1 518 rvcorr = -0.654 519 write (i02,80005) ivtnum, rvcomp, rvcorr 520 9581 continue 521c 522c test 958 through test 960 contain function tests for hyperbolic 523c tangent functions where the argument and function are real 524c 525 ivtnum = 958 526c 527c **** test 958 **** 528c 529 if (iczero) 39580, 9580, 39580 530 9580 continue 531 rvcomp = tanh (0.0) 532 go to 49580 53339580 ivdele = ivdele + 1 534 write (i02,80003) ivtnum 535 if (iczero) 49580, 9591, 49580 53649580 if (rvcomp + .00005) 29580,19580,49581 53749581 if (rvcomp - .00005) 19580,19580,29580 53819580 ivpass = ivpass + 1 539 write (i02,80001) ivtnum 540 go to 9591 54129580 ivfail = ivfail + 1 542 rvcorr = 0.00000 543 write (i02,80005) ivtnum, rvcomp, rvcorr 544 9591 continue 545 ivtnum = 959 546c 547c **** test 959 **** 548c 549 if (iczero) 39590, 9590, 39590 550 9590 continue 551 rvon01 = .5e0 552 rvcomp = tanh (rvon01) 553 go to 49590 55439590 ivdele = ivdele + 1 555 write (i02,80003) ivtnum 556 if (iczero) 49590, 9601, 49590 55749590 if (rvcomp - .457) 29590,19590,49591 55849591 if (rvcomp - .467) 19590,19590,29590 55919590 ivpass = ivpass + 1 560 write (i02,80001) ivtnum 561 go to 9601 56229590 ivfail = ivfail + 1 563 rvcorr = 0.462 564 write (i02,80005) ivtnum, rvcomp, rvcorr 565 9601 continue 566 ivtnum = 960 567c 568c **** test 960 **** 569c 570 if (iczero) 39600, 9600, 39600 571 9600 continue 572 rvon01 = .25 573 rvcomp = tanh (rvon01) 574 go to 49600 57539600 ivdele = ivdele + 1 576 write (i02,80003) ivtnum 577 if (iczero) 49600, 9611, 49600 57849600 if (rvcomp - .240) 29600,19600,49601 57949601 if (rvcomp - .250) 19600,19600,29600 58019600 ivpass = ivpass + 1 581 write (i02,80001) ivtnum 582 go to 9611 58329600 ivfail = ivfail + 1 584 rvcorr = 0.245 585 write (i02,80005) ivtnum, rvcomp, rvcorr 586 9611 continue 587c 588c tests 961 and 962 contain tests for arctangent of the form 589c atan (a) where the argument and function are real 590c 591 ivtnum = 961 592c 593c **** test 961 **** 594c 595 if (iczero) 39610, 9610, 39610 596 9610 continue 597 rvcomp = atan (0.0) 598 go to 49610 59939610 ivdele = ivdele + 1 600 write (i02,80003) ivtnum 601 if (iczero) 49610, 9621, 49610 60249610 if (rvcomp + .00005) 29610,19610,49611 60349611 if (rvcomp - .00005) 19610,19610,29610 60419610 ivpass = ivpass + 1 605 write (i02,80001) ivtnum 606 go to 9621 60729610 ivfail = ivfail + 1 608 rvcorr = 0.00000 609 write (i02,80005) ivtnum, rvcomp, rvcorr 610 9621 continue 611 ivtnum = 962 612c 613c **** test 962 **** 614c 615 if (iczero) 39620, 9620, 39620 616 9620 continue 617 rvon01 = 5e-1 618 rvcomp = atan (rvon01) 619 go to 49620 62039620 ivdele = ivdele + 1 621 write (i02,80003) ivtnum 622 if (iczero) 49620, 9631, 49620 62349620 if (rvcomp - .459) 29620,19620,49621 62449621 if (rvcomp - .469) 19620,19620,29620 62519620 ivpass = ivpass + 1 626 write (i02,80001) ivtnum 627 go to 9631 62829620 ivfail = ivfail + 1 629 rvcorr = 0.464 630 write (i02,80005) ivtnum, rvcomp, rvcorr 631 9631 continue 632c 633c tests 963 and 964 contain tests for arctangent of the form 634c atan2 (a1,a2) where the arguments and function are real 635c 636 ivtnum = 963 637c 638c **** test 963 **** 639c 640 if (iczero) 39630, 9630, 39630 641 9630 continue 642 rvon01 = 0.0 643 rvon02 = 1e0 644 rvcomp = atan2 (rvon01,rvon02) 645 go to 49630 64639630 ivdele = ivdele + 1 647 write (i02,80003) ivtnum 648 if (iczero) 49630, 9641, 49630 64949630 if (rvcomp + .00005) 29630,19630,49631 65049631 if (rvcomp - .00005) 19630,19630,29630 65119630 ivpass = ivpass + 1 652 write (i02,80001) ivtnum 653 go to 9641 65429630 ivfail = ivfail + 1 655 rvcorr = 0.00000 656 write (i02,80005) ivtnum, rvcomp, rvcorr 657 9641 continue 658 ivtnum = 964 659c 660c **** test 964 **** 661c 662 if (iczero) 39640, 9640, 39640 663 9640 continue 664 rvon01 = 2e1 665 rvcomp = atan2 (-1.0,rvon01) 666 go to 49640 66739640 ivdele = ivdele + 1 668 write (i02,80003) ivtnum 669 if (iczero) 49640, 9651, 49640 67049640 if (rvcomp + .05001) 29640,19640,49641 67149641 if (rvcomp + .04991) 19640,19640,29640 67219640 ivpass = ivpass + 1 673 write (i02,80001) ivtnum 674 go to 9651 67529640 ivfail = ivfail + 1 676 rvcorr = -.04996 677 write (i02,80005) ivtnum, rvcomp, rvcorr 678 9651 continue 679c 680c write page footings and run summaries 68199999 continue 682 write (i02,90002) 683 write (i02,90006) 684 write (i02,90002) 685 write (i02,90002) 686 write (i02,90007) 687 write (i02,90002) 688 write (i02,90008) ivfail 689 write (i02,90009) ivpass 690 write (i02,90010) ivdele 691c 692c 693c terminate routine execution 694 stop 695c 696c format statements for page headers 69790000 format (1h1) 69890002 format (1h ) 69990001 format (1h ,10x,34hfortran compiler validation system) 70090003 format (1h ,21x,11hversion 1.0) 70190004 format (1h ,10x,38hfor official use only - copyright 1978) 70290005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) 70390006 format (1h ,5x,46h----------------------------------------------) 70490011 format (1h ,18x,17hsubset level test) 705c 706c format statements for run summaries 70790008 format (1h ,15x,i5,19h errors encountered) 70890009 format (1h ,15x,i5,13h tests passed) 70990010 format (1h ,15x,i5,14h tests deleted) 710c 711c format statements for test results 71280001 format (1h ,4x,i5,7x,4hpass) 71380002 format (1h ,4x,i5,7x,4hfail) 71480003 format (1h ,4x,i5,7x,7hdeleted) 71580004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) 71680005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) 717c 71890007 format (1h ,20x,20hend of program fm099) 719 end 720