1c 2c comment section. 3c 4c fm021 5c 6c this routine tests the fortran data initialization 7c statement. integer, real, and logical data types are tested 8c using unsigned constants, signed constants, and logical 9c constants.. integer, real, logical, and mixed type arrays 10c are also tested. 11c 12c references 13c american national standard programming language fortran, 14c x3.9-1978 15c 16c section 4.1.3, data type preparation 17c section 4.4.3, real constant 18c section 9, data statement 19c 20 integer ratn11(3) 21 logical lctn01, lctn02, latn11(3), ladn11 22 real iatn11(3) 23 dimension iadn11(3), radn11(4), ladn11(6), radn13(4), iadn12(4) 24 dimension iadn13(4) 25c 26 data icon01/0/ 27 data icon02/3/ 28 data icon03/76/ 29 data icon04/587/ 30 data icon05/9999/ 31 data icon06/32767/ 32 data icon07/-0/ 33 data icon08/-32766/ 34 data icon09/00003/ 35 data icon10/ 3 2 7 6 7 / 36 data lctn01/.true./ 37 data lctn02/.false./ 38 data rcon01/0./ 39 data rcon02 /.0/ 40 data rcon03/0.0/ 41 data rcon04/32767./ 42 data rcon05/-32766./ 43 data rcon06/-000587./ 44 data rcon07/99.99/ 45 data rcon08/ -03. 2 7 6 6/ 46 data iadn11(1)/3/, iadn11(3)/-587/, iadn11(2)/32767/ 47 data iadn12/4*9999/ 48 data iadn13/0,2*-32766,-587/ 49 data ladn11/.true., .false., 2*.true., 2*.false./ 50 data radn11/32767., -32.766, 2*587./ 51 data latn11/.true., 2*.false./, iatn11/2*32767., -32766./ 52 data ratn11/3*-32766/ 53 data radn13/32.767e03, -3.2766e-01, .587e+03, 9e1/ 54c 55c 56c ********************************************************** 57c 58c a compiler validation system for the fortran language 59c based on specifications as defined in american national standard 60c programming language fortran x3.9-1978, has been developed by the 61c federal cobol compiler testing service. the fortran compiler 62c validation system (fcvs) consists of audit routines, their related 63c data, and an executive system. each audit routine is a fortran 64c program, subprogram or function which includes tests of specific 65c language elements and supporting procedures indicating the result 66c of executing these tests. 67c 68c this particular program/subprogram/function contains features 69c found only in the subset as defined in x3.9-1978. 70c 71c suggestions and comments should be forwarded to - 72c 73c department of the navy 74c federal cobol compiler testing service 75c washington, d.c. 20376 76c 77c ********************************************************** 78c 79c 80c 81c initialization section 82c 83c initialize constants 84c ************** 85c i01 contains the logical unit number for the card reader. 86 i01 = 5 87c i02 contains the logical unit number for the printer. 88 i02 = 6 89c system environment section 90c 91cx010 this card is replaced by contents of fexec x-010 control card. 92c the cx010 card is for overriding the program default i01 = 5 93c (unit number for card reader). 94cx011 this card is replaced by contents of fexec x-011 control card. 95c the cx011 card is for systems which require additional 96c fortran statements for files associated with cx010 above. 97c 98cx020 this card is replaced by contents of fexec x-020 control card. 99c the cx020 card is for overriding the program default i02 = 6 100c (unit number for printer). 101cx021 this card is replaced by contents of fexec x-021 control card. 102c the cx021 card is for systems which require additional 103c fortran statements for files associated with cx020 above. 104c 105 ivpass=0 106 ivfail=0 107 ivdele=0 108 iczero=0 109c 110c write page headers 111 write (i02,90000) 112 write (i02,90001) 113 write (i02,90002) 114 write (i02, 90002) 115 write (i02,90003) 116 write (i02,90002) 117 write (i02,90004) 118 write (i02,90002) 119 write (i02,90011) 120 write (i02,90002) 121 write (i02,90002) 122 write (i02,90005) 123 write (i02,90006) 124 write (i02,90002) 125 ivtnum = 565 126c 127c **** test 565 **** 128c test 565 - test of an integer variable set to the integer 129c constant zero. 130c 131c 132 if (iczero) 35650, 5650, 35650 133 5650 continue 134 go to 45650 13535650 ivdele = ivdele + 1 136 write (i02,80003) ivtnum 137 if (iczero) 45650, 5661, 45650 13845650 if ( icon01 - 0 ) 25650, 15650, 25650 13915650 ivpass = ivpass + 1 140 write (i02,80001) ivtnum 141 go to 5661 14225650 ivfail = ivfail + 1 143 ivcomp = icon01 144 ivcorr = 0 145 write (i02,80004) ivtnum, ivcomp ,ivcorr 146 5661 continue 147 ivtnum = 566 148c 149c **** test 566 **** 150c test 566 - test of an integer variable set to the integer 151c constant 3. 152c 153c 154 if (iczero) 35660, 5660, 35660 155 5660 continue 156 go to 45660 15735660 ivdele = ivdele + 1 158 write (i02,80003) ivtnum 159 if (iczero) 45660, 5671, 45660 16045660 if ( icon02 - 3 ) 25660, 15660, 25660 16115660 ivpass = ivpass + 1 162 write (i02,80001) ivtnum 163 go to 5671 16425660 ivfail = ivfail + 1 165 ivcomp = icon02 166 ivcorr = 3 167 write (i02,80004) ivtnum, ivcomp ,ivcorr 168 5671 continue 169 ivtnum = 567 170c 171c **** test 567 **** 172c test 567 - test of an integer variable set to the integer 173c constant 76. 174c 175c 176 if (iczero) 35670, 5670, 35670 177 5670 continue 178 go to 45670 17935670 ivdele = ivdele + 1 180 write (i02,80003) ivtnum 181 if (iczero) 45670, 5681, 45670 18245670 if ( icon03 - 76 ) 25670, 15670, 25670 18315670 ivpass = ivpass + 1 184 write (i02,80001) ivtnum 185 go to 5681 18625670 ivfail = ivfail + 1 187 ivcomp = icon03 188 ivcorr = 76 189 write (i02,80004) ivtnum, ivcomp ,ivcorr 190 5681 continue 191 ivtnum = 568 192c 193c **** test 568 **** 194c test 568 - test of an integer variable set to the integer 195c constant 587. 196c 197c 198 if (iczero) 35680, 5680, 35680 199 5680 continue 200 go to 45680 20135680 ivdele = ivdele + 1 202 write (i02,80003) ivtnum 203 if (iczero) 45680, 5691, 45680 20445680 if ( icon04 - 587 ) 25680, 15680, 25680 20515680 ivpass = ivpass + 1 206 write (i02,80001) ivtnum 207 go to 5691 20825680 ivfail = ivfail + 1 209 ivcomp = icon04 210 ivcorr = 587 211 write (i02,80004) ivtnum, ivcomp ,ivcorr 212 5691 continue 213 ivtnum = 569 214c 215c **** test 569 **** 216c test 569 - test of an integer variable set to the integer 217c constant 9999. 218c 219c 220 if (iczero) 35690, 5690, 35690 221 5690 continue 222 go to 45690 22335690 ivdele = ivdele + 1 224 write (i02,80003) ivtnum 225 if (iczero) 45690, 5701, 45690 22645690 if ( icon05 - 9999 ) 25690, 15690, 25690 22715690 ivpass = ivpass + 1 228 write (i02,80001) ivtnum 229 go to 5701 23025690 ivfail = ivfail + 1 231 ivcomp = icon05 232 ivcorr = 9999 233 write (i02,80004) ivtnum, ivcomp ,ivcorr 234 5701 continue 235 ivtnum = 570 236c 237c **** test 570 **** 238c test 570 - test of an integer variable set to the integer 239c constant 32767. 240c 241c 242 if (iczero) 35700, 5700, 35700 243 5700 continue 244 go to 45700 24535700 ivdele = ivdele + 1 246 write (i02,80003) ivtnum 247 if (iczero) 45700, 5711, 45700 24845700 if ( icon06 - 32767 ) 25700, 15700, 25700 24915700 ivpass = ivpass + 1 250 write (i02,80001) ivtnum 251 go to 5711 25225700 ivfail = ivfail + 1 253 ivcomp = icon06 254 ivcorr = 32767 255 write (i02,80004) ivtnum, ivcomp ,ivcorr 256 5711 continue 257 ivtnum = 571 258c 259c **** test 571 **** 260c test 571 - test of an integer variable set to the integer 261c constant -0. note that signed zero and unsigned zero 262c should be equal for any integer operation. 263c 264c 265 if (iczero) 35710, 5710, 35710 266 5710 continue 267 go to 45710 26835710 ivdele = ivdele + 1 269 write (i02,80003) ivtnum 270 if (iczero) 45710, 5721, 45710 27145710 if ( icon07 - 0 ) 25710, 15710, 25710 27215710 ivpass = ivpass + 1 273 write (i02,80001) ivtnum 274 go to 5721 27525710 ivfail = ivfail + 1 276 ivcomp = icon07 277 ivcorr = -0 278 write (i02,80004) ivtnum, ivcomp ,ivcorr 279 5721 continue 280 ivtnum = 572 281c 282c **** test 572 **** 283c test 572 - test of an integer variable set to the integer 284c constant (signed) -32766. 285c 286c 287 if (iczero) 35720, 5720, 35720 288 5720 continue 289 go to 45720 29035720 ivdele = ivdele + 1 291 write (i02,80003) ivtnum 292 if (iczero) 45720, 5731, 45720 29345720 if ( icon08 + 32766 ) 25720, 15720, 25720 29415720 ivpass = ivpass + 1 295 write (i02,80001) ivtnum 296 go to 5731 29725720 ivfail = ivfail + 1 298 ivcomp = icon08 299 ivcorr = -32766 300 write (i02,80004) ivtnum, ivcomp ,ivcorr 301 5731 continue 302 ivtnum = 573 303c 304c **** test 573 **** 305c test 573 - test the effect of leading zero on an integer 306c constant 00003. 307c 308c 309 if (iczero) 35730, 5730, 35730 310 5730 continue 311 go to 45730 31235730 ivdele = ivdele + 1 313 write (i02,80003) ivtnum 314 if (iczero) 45730, 5741, 45730 31545730 if ( icon09 - 3 ) 25730, 15730, 25730 31615730 ivpass = ivpass + 1 317 write (i02,80001) ivtnum 318 go to 5741 31925730 ivfail = ivfail + 1 320 ivcomp = icon09 321 ivcorr = 3 322 write (i02,80004) ivtnum, ivcomp ,ivcorr 323 5741 continue 324 ivtnum = 574 325c 326c **** test 574 **** 327c test 574 - test of blanks imbedded in an integer constant 328c which was / 3 2 7 6 7/ in the data initialization statement. 329c 330c 331 if (iczero) 35740, 5740, 35740 332 5740 continue 333 go to 45740 33435740 ivdele = ivdele + 1 335 write (i02,80003) ivtnum 336 if (iczero) 45740, 5751, 45740 33745740 if ( icon10 - 32767 ) 25740, 15740, 25740 33815740 ivpass = ivpass + 1 339 write (i02,80001) ivtnum 340 go to 5751 34125740 ivfail = ivfail + 1 342 ivcomp = icon10 343 ivcorr = 32767 344 write (i02,80004) ivtnum, ivcomp ,ivcorr 345 5751 continue 346 ivtnum = 575 347c 348c **** test 575 **** 349c test 575 - test of a logical variable set to the logical 350c constant .true. 351c true path of a logical if statement is used in the test. 352c 353c 354 if (iczero) 35750, 5750, 35750 355 5750 continue 356 ivon01 = 0 357 if ( lctn01 ) ivon01 = 1 358 go to 45750 35935750 ivdele = ivdele + 1 360 write (i02,80003) ivtnum 361 if (iczero) 45750, 5761, 45750 36245750 if ( ivon01 - 1 ) 25750, 15750, 25750 36315750 ivpass = ivpass + 1 364 write (i02,80001) ivtnum 365 go to 5761 36625750 ivfail = ivfail + 1 367 ivcomp = ivon01 368 ivcorr = 1 369 write (i02,80004) ivtnum, ivcomp ,ivcorr 370 5761 continue 371 ivtnum = 576 372c 373c **** test 576 **** 374c test 576 - test of a logical variable set to the logical 375c constant .false. the false path of a logical if statement 376c is also used in the test. 377c 378c 379 if (iczero) 35760, 5760, 35760 380 5760 continue 381 ivon01 = 1 382 if ( lctn02 ) ivon01 = 0 383 go to 45760 38435760 ivdele = ivdele + 1 385 write (i02,80003) ivtnum 386 if (iczero) 45760, 5771, 45760 38745760 if ( ivon01 - 1 ) 25760, 15760, 25760 38815760 ivpass = ivpass + 1 389 write (i02,80001) ivtnum 390 go to 5771 39125760 ivfail = ivfail + 1 392 ivcomp = ivon01 393 ivcorr = 1 394 write (i02,80004) ivtnum, ivcomp ,ivcorr 395 5771 continue 396 ivtnum = 577 397c 398c **** test 577 **** 399c test 577 - real variable set to 0. 400c 401c 402 if (iczero) 35770, 5770, 35770 403 5770 continue 404 go to 45770 40535770 ivdele = ivdele + 1 406 write (i02,80003) ivtnum 407 if (iczero) 45770, 5781, 45770 40845770 if ( rcon01 - 0. ) 25770, 15770, 25770 40915770 ivpass = ivpass + 1 410 write (i02,80001) ivtnum 411 go to 5781 41225770 ivfail = ivfail + 1 413 ivcomp = rcon01 414 ivcorr = 0 415 write (i02,80004) ivtnum, ivcomp ,ivcorr 416 5781 continue 417 ivtnum = 578 418c 419c **** test 578 **** 420c test 578 - real variable set to .0 421c 422c 423 if (iczero) 35780, 5780, 35780 424 5780 continue 425 go to 45780 42635780 ivdele = ivdele + 1 427 write (i02,80003) ivtnum 428 if (iczero) 45780, 5791, 45780 42945780 if ( rcon02 - .0 ) 25780, 15780, 25780 43015780 ivpass = ivpass + 1 431 write (i02,80001) ivtnum 432 go to 5791 43325780 ivfail = ivfail + 1 434 ivcomp = rcon02 435 ivcorr = 0 436 write (i02,80004) ivtnum, ivcomp ,ivcorr 437 5791 continue 438 ivtnum = 579 439c 440c **** test 579 **** 441c test 579 - real variable set to 0.0 442c 443c 444 if (iczero) 35790, 5790, 35790 445 5790 continue 446 go to 45790 44735790 ivdele = ivdele + 1 448 write (i02,80003) ivtnum 449 if (iczero) 45790, 5801, 45790 45045790 if ( rcon03 - 0.0 ) 25790, 15790, 25790 45115790 ivpass = ivpass + 1 452 write (i02,80001) ivtnum 453 go to 5801 45425790 ivfail = ivfail + 1 455 ivcomp = rcon03 456 ivcorr = 0 457 write (i02,80004) ivtnum, ivcomp ,ivcorr 458 5801 continue 459 ivtnum = 580 460c 461c **** test 580 **** 462c test 580 - real variable set to 32767. 463c 464c 465 if (iczero) 35800, 5800, 35800 466 5800 continue 467 go to 45800 46835800 ivdele = ivdele + 1 469 write (i02,80003) ivtnum 470 if (iczero) 45800, 5811, 45800 47145800 if ( rcon04 - 32767. ) 25800, 15800, 25800 47215800 ivpass = ivpass + 1 473 write (i02,80001) ivtnum 474 go to 5811 47525800 ivfail = ivfail + 1 476 ivcomp = rcon04 477 ivcorr = 32767 478 write (i02,80004) ivtnum, ivcomp ,ivcorr 479 5811 continue 480 ivtnum = 581 481c 482c **** test 581 **** 483c test 581 - real variable set to -32766. 484c 485c 486 if (iczero) 35810, 5810, 35810 487 5810 continue 488 go to 45810 48935810 ivdele = ivdele + 1 490 write (i02,80003) ivtnum 491 if (iczero) 45810, 5821, 45810 49245810 if ( rcon05 + 32766 ) 25810, 15810, 25810 49315810 ivpass = ivpass + 1 494 write (i02,80001) ivtnum 495 go to 5821 49625810 ivfail = ivfail + 1 497 ivcomp = rcon05 498 ivcorr = -32766 499 write (i02,80004) ivtnum, ivcomp ,ivcorr 500 5821 continue 501 ivtnum = 582 502c 503c **** test 582 **** 504c test 582 - real variable set to -000587. test of leading sign 505c and leading zeros on a real constant. 506c 507c 508 if (iczero) 35820, 5820, 35820 509 5820 continue 510 go to 45820 51135820 ivdele = ivdele + 1 512 write (i02,80003) ivtnum 513 if (iczero) 45820, 5831, 45820 51445820 if ( rcon06 + 587. ) 25820, 15820, 25820 51515820 ivpass = ivpass + 1 516 write (i02,80001) ivtnum 517 go to 5831 51825820 ivfail = ivfail + 1 519 ivcomp = rcon06 520 ivcorr = -587 521 write (i02,80004) ivtnum, ivcomp ,ivcorr 522 5831 continue 523 ivtnum = 583 524c 525c **** test 583 **** 526c test 583 - real variable set to 99.99 527c 528c 529 if (iczero) 35830, 5830, 35830 530 5830 continue 531 go to 45830 53235830 ivdele = ivdele + 1 533 write (i02,80003) ivtnum 534 if (iczero) 45830, 5841, 45830 53545830 if ( rcon07 - 99.99 ) 25830, 15830, 25830 53615830 ivpass = ivpass + 1 537 write (i02,80001) ivtnum 538 go to 5841 53925830 ivfail = ivfail + 1 540 ivcomp = rcon07 541 ivcorr = 99 542 write (i02,80004) ivtnum, ivcomp ,ivcorr 543 5841 continue 544 ivtnum = 584 545c 546c **** test 584 **** 547c test 584 - real variable set to /-03. 2 7 6 6/ to test 548c the effect of blanks imbedded in a real constant. 549c 550c 551 if (iczero) 35840, 5840, 35840 552 5840 continue 553 go to 45840 55435840 ivdele = ivdele + 1 555 write (i02,80003) ivtnum 556 if (iczero) 45840, 5851, 45840 55745840 if ( rcon08 + 3.2766 ) 25840, 15840, 25840 55815840 ivpass = ivpass + 1 559 write (i02,80001) ivtnum 560 go to 5851 56125840 ivfail = ivfail + 1 562 ivcomp = rcon08 563 ivcorr = -3 564 write (i02,80004) ivtnum, ivcomp ,ivcorr 565 5851 continue 566 ivtnum = 585 567c 568c **** test 585 **** 569c test 585 - integer array element set to 3 570c 571c 572 if (iczero) 35850, 5850, 35850 573 5850 continue 574 go to 45850 57535850 ivdele = ivdele + 1 576 write (i02,80003) ivtnum 577 if (iczero) 45850, 5861, 45850 57845850 if ( iadn11(1) - 3 ) 25850, 15850, 25850 57915850 ivpass = ivpass + 1 580 write (i02,80001) ivtnum 581 go to 5861 58225850 ivfail = ivfail + 1 583 ivcomp = iadn11(1) 584 ivcorr = 3 585 write (i02,80004) ivtnum, ivcomp ,ivcorr 586 5861 continue 587 ivtnum = 586 588c 589c **** test 586 **** 590c test 586 - integer array element set to 32767 591c 592c 593 if (iczero) 35860, 5860, 35860 594 5860 continue 595 go to 45860 59635860 ivdele = ivdele + 1 597 write (i02,80003) ivtnum 598 if (iczero) 45860, 5871, 45860 59945860 if ( iadn11(2) - 32767 ) 25860, 15860, 25860 60015860 ivpass = ivpass + 1 601 write (i02,80001) ivtnum 602 go to 5871 60325860 ivfail = ivfail + 1 604 ivcomp = iadn11(2) 605 ivcorr = 32767 606 write (i02,80004) ivtnum, ivcomp ,ivcorr 607 5871 continue 608 ivtnum = 587 609c 610c **** test 587 **** 611c test 587 - integer array element set to -587 612c 613c 614 if (iczero) 35870, 5870, 35870 615 5870 continue 616 go to 45870 61735870 ivdele = ivdele + 1 618 write (i02,80003) ivtnum 619 if (iczero) 45870, 5881, 45870 62045870 if ( iadn11(3) + 587 ) 25870, 15870, 25870 62115870 ivpass = ivpass + 1 622 write (i02,80001) ivtnum 623 go to 5881 62425870 ivfail = ivfail + 1 625 ivcomp = iadn11(3) 626 ivcorr = -587 627 write (i02,80004) ivtnum, ivcomp ,ivcorr 628 5881 continue 629 ivtnum = 588 630c 631c **** test 588 **** 632c test 588 - test of the repeat field /4*999/ in a data state. 633c 634c 635 if (iczero) 35880, 5880, 35880 636 5880 continue 637 go to 45880 63835880 ivdele = ivdele + 1 639 write (i02,80003) ivtnum 640 if (iczero) 45880, 5891, 45880 64145880 if ( iadn12(3) - 9999 ) 25880, 15880, 25880 64215880 ivpass = ivpass + 1 643 write (i02,80001) ivtnum 644 go to 5891 64525880 ivfail = ivfail + 1 646 ivcomp = iadn12(3) 647 ivcorr = 9999 648 write (i02,80004) ivtnum, ivcomp ,ivcorr 649 5891 continue 650 ivtnum = 589 651c 652c **** test 589 **** 653c test 589 - test of setting the whole integer array elements 654c in one data initialization statement. the first element 655c is set to 0 656c 657c 658 if (iczero) 35890, 5890, 35890 659 5890 continue 660 go to 45890 66135890 ivdele = ivdele + 1 662 write (i02,80003) ivtnum 663 if (iczero) 45890, 5901, 45890 66445890 if ( iadn13(1) - 0 ) 25890, 15890, 25890 66515890 ivpass = ivpass + 1 666 write (i02,80001) ivtnum 667 go to 5901 66825890 ivfail = ivfail + 1 669 ivcomp = iadn13(1) 670 ivcorr = 0 671 write (i02,80004) ivtnum, ivcomp ,ivcorr 672 5901 continue 673 ivtnum = 590 674c 675c **** test 590 **** 676c test 590 - see test 589. the second element was set to -32766 677c 678c 679 if (iczero) 35900, 5900, 35900 680 5900 continue 681 go to 45900 68235900 ivdele = ivdele + 1 683 write (i02,80003) ivtnum 684 if (iczero) 45900, 5911, 45900 68545900 if ( iadn13(2) + 32766 ) 25900, 15900, 25900 68615900 ivpass = ivpass + 1 687 write (i02,80001) ivtnum 688 go to 5911 68925900 ivfail = ivfail + 1 690 ivcomp = iadn13(2) 691 ivcorr = -32766 692 write (i02,80004) ivtnum, ivcomp ,ivcorr 693 5911 continue 694 ivtnum = 591 695c 696c **** test 591 **** 697c test 591 - see test 589. the third element was set to -32766 698c 699c 700 if (iczero) 35910, 5910, 35910 701 5910 continue 702 go to 45910 70335910 ivdele = ivdele + 1 704 write (i02,80003) ivtnum 705 if (iczero) 45910, 5921, 45910 70645910 if ( iadn13(3) + 32766 ) 25910, 15910, 25910 70715910 ivpass = ivpass + 1 708 write (i02,80001) ivtnum 709 go to 5921 71025910 ivfail = ivfail + 1 711 ivcomp = iadn13(3) 712 ivcorr = -32766 713 write (i02,80004) ivtnum, ivcomp ,ivcorr 714 5921 continue 715 ivtnum = 592 716c 717c **** test 592 **** 718c test 592 - see test 589. the fourth element was set to -587 719c 720c 721 if (iczero) 35920, 5920, 35920 722 5920 continue 723 go to 45920 72435920 ivdele = ivdele + 1 725 write (i02,80003) ivtnum 726 if (iczero) 45920, 5931, 45920 72745920 if ( iadn13(4) + 587 ) 25920, 15920, 25920 72815920 ivpass = ivpass + 1 729 write (i02,80001) ivtnum 730 go to 5931 73125920 ivfail = ivfail + 1 732 ivcomp = iadn13(4) 733 ivcorr = -587 734 write (i02,80004) ivtnum, ivcomp ,ivcorr 735 5931 continue 736 ivtnum = 593 737c 738c **** test 593 **** 739c test 593 - test of setting the whole logical array in one 740c data initialization statement. the first element is .true. 741c the second and third elements are .false. 742c the false path of a logical if statement is used testing 2. 743c 744c 745 if (iczero) 35930, 5930, 35930 746 5930 continue 747 ivon01 = 1 748 if ( ladn11(2) ) ivon01 = 0 749 go to 45930 75035930 ivdele = ivdele + 1 751 write (i02,80003) ivtnum 752 if (iczero) 45930, 5941, 45930 75345930 if ( ivon01 - 1 ) 25930, 15930, 25930 75415930 ivpass = ivpass + 1 755 write (i02,80001) ivtnum 756 go to 5941 75725930 ivfail = ivfail + 1 758 ivcomp = ivon01 759 ivcorr = 1 760 write (i02,80004) ivtnum, ivcomp ,ivcorr 761 5941 continue 762 ivtnum = 594 763c 764c **** test 594 **** 765c test 594 - see test 593. the fourth element is tested 766c with the true path of the logical if statement. 767c 768c 769 if (iczero) 35940, 5940, 35940 770 5940 continue 771 ivon01 = 0 772 if ( ladn11(4) ) ivon01 = 1 773 go to 45940 77435940 ivdele = ivdele + 1 775 write (i02,80003) ivtnum 776 if (iczero) 45940, 5951, 45940 77745940 if ( ivon01 - 1 ) 25940, 15940, 25940 77815940 ivpass = ivpass + 1 779 write (i02,80001) ivtnum 780 go to 5951 78125940 ivfail = ivfail + 1 782 ivcomp = ivon01 783 ivcorr = 1 784 write (i02,80004) ivtnum, ivcomp ,ivcorr 785 5951 continue 786 ivtnum = 595 787c 788c **** test 595 **** 789c test 595 - a whole real array is set in one data initialization 790c statement. the second element is -32.766 791c 792c 793 if (iczero) 35950, 5950, 35950 794 5950 continue 795 go to 45950 79635950 ivdele = ivdele + 1 797 write (i02,80003) ivtnum 798 if (iczero) 45950, 5961, 45950 79945950 if ( radn11(2) + 32.766 ) 25950, 15950, 25950 80015950 ivpass = ivpass + 1 801 write (i02,80001) ivtnum 802 go to 5961 80325950 ivfail = ivfail + 1 804 ivcomp = radn11(2) 805 ivcorr = -32 806 write (i02,80004) ivtnum, ivcomp ,ivcorr 807 5961 continue 808 ivtnum = 596 809c 810c **** test 596 **** 811c test 596 - see test 595. the fourth element is set to 587 812c by a repeat field. 813c 814c 815 if (iczero) 35960, 5960, 35960 816 5960 continue 817 go to 45960 81835960 ivdele = ivdele + 1 819 write (i02,80003) ivtnum 820 if (iczero) 45960, 5971, 45960 82145960 if ( radn11(4) - 587 ) 25960, 15960, 25960 82215960 ivpass = ivpass + 1 823 write (i02,80001) ivtnum 824 go to 5971 82525960 ivfail = ivfail + 1 826 ivcomp = radn11(4) 827 ivcorr = 587 828 write (i02,80004) ivtnum, ivcomp ,ivcorr 829 5971 continue 830 ivtnum = 597 831c 832c **** test 597 **** 833c test 597 - test of mixed array element types in a single data 834c initialization statement. the type logical statement contains 835c the array declarations. the false path of a logical 836c if statement tests the logical results. 837c 838c 839 if (iczero) 35970, 5970, 35970 840 5970 continue 841 ivon01 = 1 842 if ( latn11(2) ) ivon01 = 0 843 go to 45970 84435970 ivdele = ivdele + 1 845 write (i02,80003) ivtnum 846 if (iczero) 45970, 5981, 45970 84745970 if ( ivon01 - 1 ) 25970, 15970, 25970 84815970 ivpass = ivpass + 1 849 write (i02,80001) ivtnum 850 go to 5981 85125970 ivfail = ivfail + 1 852 ivcomp = ivon01 853 ivcorr = 1 854 write (i02,80004) ivtnum, ivcomp ,ivcorr 855 5981 continue 856 ivtnum = 598 857c 858c **** test 598 **** 859c test 598 - type of the data was set explicitly real in the 860c declarative for the array. data should be set to 32767. 861c 862c 863 if (iczero) 35980, 5980, 35980 864 5980 continue 865 go to 45980 86635980 ivdele = ivdele + 1 867 write (i02,80003) ivtnum 868 if (iczero) 45980, 5991, 45980 86945980 if ( iatn11(2) - 32767. ) 25980, 15980, 25980 87015980 ivpass = ivpass + 1 871 write (i02,80001) ivtnum 872 go to 5991 87325980 ivfail = ivfail + 1 874 ivcomp = iatn11(2) 875 ivcorr = 32767 876 write (i02,80004) ivtnum, ivcomp ,ivcorr 877 5991 continue 878 ivtnum = 599 879c 880c **** test 599 **** 881c test 599 - type of the data was set explicitly integer in the 882c declarative for the array. data should be set to -32766 883c 884c 885 if (iczero) 35990, 5990, 35990 886 5990 continue 887 go to 45990 88835990 ivdele = ivdele + 1 889 write (i02,80003) ivtnum 890 if (iczero) 45990, 6001, 45990 89145990 if ( ratn11(2) + 32766 ) 25990, 15990, 25990 89215990 ivpass = ivpass + 1 893 write (i02,80001) ivtnum 894 go to 6001 89525990 ivfail = ivfail + 1 896 ivcomp = ratn11(2) 897 ivcorr = -32766 898 write (i02,80004) ivtnum, ivcomp ,ivcorr 899 6001 continue 900 ivtnum = 600 901c 902c **** test 600 **** 903c test 600 - test of real decimal constants using e-notation. 904c see section 4.4.2. the value of the element should 905c be set to 32767. 906c 907c 908 if (iczero) 36000, 6000, 36000 909 6000 continue 910 go to 46000 91136000 ivdele = ivdele + 1 912 write (i02,80003) ivtnum 913 if (iczero) 46000, 6011, 46000 91446000 if ( radn13(1) - 32767. ) 26000, 16000, 26000 91516000 ivpass = ivpass + 1 916 write (i02,80001) ivtnum 917 go to 6011 91826000 ivfail = ivfail + 1 919 ivcomp = radn13(1) 920 ivcorr = 32767 921 write (i02,80004) ivtnum, ivcomp ,ivcorr 922 6011 continue 923 ivtnum = 601 924c 925c **** test 601 **** 926c test 601 - like test 600. real decimal constant value -.32766 927c 928c 929 if (iczero) 36010, 6010, 36010 930 6010 continue 931 go to 46010 93236010 ivdele = ivdele + 1 933 write (i02,80003) ivtnum 934 if (iczero) 46010, 6021, 46010 93546010 if ( radn13(2) + .32766 ) 26010, 16010, 26010 93616010 ivpass = ivpass + 1 937 write (i02,80001) ivtnum 938 go to 6021 93926010 ivfail = ivfail + 1 940 ivcomp = radn13(2) 941 ivcorr = 0 942 write (i02,80004) ivtnum, ivcomp ,ivcorr 943 6021 continue 944 ivtnum = 602 945c 946c **** test 602 **** 947c test 602 - like test 600. real decimal constant value 587. 948c 949c 950 if (iczero) 36020, 6020, 36020 951 6020 continue 952 go to 46020 95336020 ivdele = ivdele + 1 954 write (i02,80003) ivtnum 955 if (iczero) 46020, 6031, 46020 95646020 if ( radn13(3) - 587 ) 26020, 16020, 26020 95716020 ivpass = ivpass + 1 958 write (i02,80001) ivtnum 959 go to 6031 96026020 ivfail = ivfail + 1 961 ivcomp = radn13(3) 962 ivcorr = 587 963 write (i02,80004) ivtnum, ivcomp ,ivcorr 964 6031 continue 965 ivtnum = 603 966c 967c **** test 603 **** 968c test 603 - like test 600. real decimal constant value 90. 969c 970c 971 if (iczero) 36030, 6030, 36030 972 6030 continue 973 go to 46030 97436030 ivdele = ivdele + 1 975 write (i02,80003) ivtnum 976 if (iczero) 46030, 6041, 46030 97746030 if ( radn13(4) - 90. ) 26030, 16030, 26030 97816030 ivpass = ivpass + 1 979 write (i02,80001) ivtnum 980 go to 6041 98126030 ivfail = ivfail + 1 982 ivcomp = radn13(4) 983 ivcorr = 90 984 write (i02,80004) ivtnum, ivcomp ,ivcorr 985 6041 continue 986c 987c write page footings and run summaries 98899999 continue 989 write (i02,90002) 990 write (i02,90006) 991 write (i02,90002) 992 write (i02,90002) 993 write (i02,90007) 994 write (i02,90002) 995 write (i02,90008) ivfail 996 write (i02,90009) ivpass 997 write (i02,90010) ivdele 998c 999c 1000c terminate routine execution 1001 stop 1002c 1003c format statements for page headers 100490000 format (1h1) 100590002 format (1h ) 100690001 format (1h ,10x,34hfortran compiler validation system) 100790003 format (1h ,21x,11hversion 1.0) 100890004 format (1h ,10x,38hfor official use only - copyright 1978) 100990005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) 101090006 format (1h ,5x,46h----------------------------------------------) 101190011 format (1h ,18x,17hsubset level test) 1012c 1013c format statements for run summaries 101490008 format (1h ,15x,i5,19h errors encountered) 101590009 format (1h ,15x,i5,13h tests passed) 101690010 format (1h ,15x,i5,14h tests deleted) 1017c 1018c format statements for test results 101980001 format (1h ,4x,i5,7x,4hpass) 102080002 format (1h ,4x,i5,7x,4hfail) 102180003 format (1h ,4x,i5,7x,7hdeleted) 102280004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) 102380005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) 1024c 102590007 format (1h ,20x,20hend of program fm021) 1026 end 1027