C C COMMENT SECTION. C C FM021 C C THIS ROUTINE TESTS THE FORTRAN DATA INITIALIZATION C STATEMENT. INTEGER, REAL, AND LOGICAL DATA TYPES ARE TESTED C USING UNSIGNED CONSTANTS, SIGNED CONSTANTS, AND LOGICAL C CONSTANTS.. INTEGER, REAL, LOGICAL, AND MIXED TYPE ARRAYS C ARE ALSO TESTED. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 4.1.3, DATA TYPE PREPARATION C SECTION 4.4.3, REAL CONSTANT C SECTION 9, DATA STATEMENT C INTEGER RATN11(3) LOGICAL LCTN01, LCTN02, LATN11(3), LADN11 REAL IATN11(3) DIMENSION IADN11(3), RADN11(4), LADN11(6), RADN13(4), IADN12(4) DIMENSION IADN13(4) C DATA ICON01/0/ DATA ICON02/3/ DATA ICON03/76/ DATA ICON04/587/ DATA ICON05/9999/ DATA ICON06/32767/ DATA ICON07/-0/ DATA ICON08/-32766/ DATA ICON09/00003/ DATA ICON10/ 3 2 7 6 7 / DATA LCTN01/.TRUE./ DATA LCTN02/.FALSE./ DATA RCON01/0./ DATA RCON02 /.0/ DATA RCON03/0.0/ DATA RCON04/32767./ DATA RCON05/-32766./ DATA RCON06/-000587./ DATA RCON07/99.99/ DATA RCON08/ -03. 2 7 6 6/ DATA IADN11(1)/3/, IADN11(3)/-587/, IADN11(2)/32767/ DATA IADN12/4*9999/ DATA IADN13/0,2*-32766,-587/ DATA LADN11/.TRUE., .FALSE., 2*.TRUE., 2*.FALSE./ DATA RADN11/32767., -32.766, 2*587./ DATA LATN11/.TRUE., 2*.FALSE./, IATN11/2*32767., -32766./ DATA RATN11/3*-32766/ DATA RADN13/32.767E03, -3.2766E-01, .587E+03, 9E1/ C C C ********************************************************** C C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT C OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - C C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ********************************************************** C C C C INITIALIZATION SECTION C C INITIALIZE CONSTANTS C ************** C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. I01 = 5 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. I02 = 6 C SYSTEM ENVIRONMENT SECTION C CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 C (UNIT NUMBER FOR CARD READER). CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. C CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 C (UNIT NUMBER FOR PRINTER). CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. C IVPASS=0 IVFAIL=0 IVDELE=0 ICZERO=0 C C WRITE PAGE HEADERS WRITE (I02,90000) WRITE (I02,90001) WRITE (I02,90002) WRITE (I02, 90002) WRITE (I02,90003) WRITE (I02,90002) WRITE (I02,90004) WRITE (I02,90002) WRITE (I02,90011) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90005) WRITE (I02,90006) WRITE (I02,90002) IVTNUM = 565 C C **** TEST 565 **** C TEST 565 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER C CONSTANT ZERO. C C IF (ICZERO) 35650, 5650, 35650 5650 CONTINUE GO TO 45650 35650 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45650, 5661, 45650 45650 IF ( ICON01 - 0 ) 25650, 15650, 25650 15650 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5661 25650 IVFAIL = IVFAIL + 1 IVCOMP = ICON01 IVCORR = 0 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5661 CONTINUE IVTNUM = 566 C C **** TEST 566 **** C TEST 566 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER C CONSTANT 3. C C IF (ICZERO) 35660, 5660, 35660 5660 CONTINUE GO TO 45660 35660 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45660, 5671, 45660 45660 IF ( ICON02 - 3 ) 25660, 15660, 25660 15660 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5671 25660 IVFAIL = IVFAIL + 1 IVCOMP = ICON02 IVCORR = 3 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5671 CONTINUE IVTNUM = 567 C C **** TEST 567 **** C TEST 567 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER C CONSTANT 76. C C IF (ICZERO) 35670, 5670, 35670 5670 CONTINUE GO TO 45670 35670 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45670, 5681, 45670 45670 IF ( ICON03 - 76 ) 25670, 15670, 25670 15670 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5681 25670 IVFAIL = IVFAIL + 1 IVCOMP = ICON03 IVCORR = 76 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5681 CONTINUE IVTNUM = 568 C C **** TEST 568 **** C TEST 568 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER C CONSTANT 587. C C IF (ICZERO) 35680, 5680, 35680 5680 CONTINUE GO TO 45680 35680 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45680, 5691, 45680 45680 IF ( ICON04 - 587 ) 25680, 15680, 25680 15680 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5691 25680 IVFAIL = IVFAIL + 1 IVCOMP = ICON04 IVCORR = 587 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5691 CONTINUE IVTNUM = 569 C C **** TEST 569 **** C TEST 569 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER C CONSTANT 9999. C C IF (ICZERO) 35690, 5690, 35690 5690 CONTINUE GO TO 45690 35690 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45690, 5701, 45690 45690 IF ( ICON05 - 9999 ) 25690, 15690, 25690 15690 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5701 25690 IVFAIL = IVFAIL + 1 IVCOMP = ICON05 IVCORR = 9999 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5701 CONTINUE IVTNUM = 570 C C **** TEST 570 **** C TEST 570 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER C CONSTANT 32767. C C IF (ICZERO) 35700, 5700, 35700 5700 CONTINUE GO TO 45700 35700 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45700, 5711, 45700 45700 IF ( ICON06 - 32767 ) 25700, 15700, 25700 15700 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5711 25700 IVFAIL = IVFAIL + 1 IVCOMP = ICON06 IVCORR = 32767 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5711 CONTINUE IVTNUM = 571 C C **** TEST 571 **** C TEST 571 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER C CONSTANT -0. NOTE THAT SIGNED ZERO AND UNSIGNED ZERO C SHOULD BE EQUAL FOR ANY INTEGER OPERATION. C C IF (ICZERO) 35710, 5710, 35710 5710 CONTINUE GO TO 45710 35710 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45710, 5721, 45710 45710 IF ( ICON07 - 0 ) 25710, 15710, 25710 15710 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5721 25710 IVFAIL = IVFAIL + 1 IVCOMP = ICON07 IVCORR = -0 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5721 CONTINUE IVTNUM = 572 C C **** TEST 572 **** C TEST 572 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER C CONSTANT (SIGNED) -32766. C C IF (ICZERO) 35720, 5720, 35720 5720 CONTINUE GO TO 45720 35720 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45720, 5731, 45720 45720 IF ( ICON08 + 32766 ) 25720, 15720, 25720 15720 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5731 25720 IVFAIL = IVFAIL + 1 IVCOMP = ICON08 IVCORR = -32766 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5731 CONTINUE IVTNUM = 573 C C **** TEST 573 **** C TEST 573 - TEST THE EFFECT OF LEADING ZERO ON AN INTEGER C CONSTANT 00003. C C IF (ICZERO) 35730, 5730, 35730 5730 CONTINUE GO TO 45730 35730 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45730, 5741, 45730 45730 IF ( ICON09 - 3 ) 25730, 15730, 25730 15730 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5741 25730 IVFAIL = IVFAIL + 1 IVCOMP = ICON09 IVCORR = 3 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5741 CONTINUE IVTNUM = 574 C C **** TEST 574 **** C TEST 574 - TEST OF BLANKS IMBEDDED IN AN INTEGER CONSTANT C WHICH WAS / 3 2 7 6 7/ IN THE DATA INITIALIZATION STATEMENT. C C IF (ICZERO) 35740, 5740, 35740 5740 CONTINUE GO TO 45740 35740 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45740, 5751, 45740 45740 IF ( ICON10 - 32767 ) 25740, 15740, 25740 15740 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5751 25740 IVFAIL = IVFAIL + 1 IVCOMP = ICON10 IVCORR = 32767 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5751 CONTINUE IVTNUM = 575 C C **** TEST 575 **** C TEST 575 - TEST OF A LOGICAL VARIABLE SET TO THE LOGICAL C CONSTANT .TRUE. C TRUE PATH OF A LOGICAL IF STATEMENT IS USED IN THE TEST. C C IF (ICZERO) 35750, 5750, 35750 5750 CONTINUE IVON01 = 0 IF ( LCTN01 ) IVON01 = 1 GO TO 45750 35750 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45750, 5761, 45750 45750 IF ( IVON01 - 1 ) 25750, 15750, 25750 15750 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5761 25750 IVFAIL = IVFAIL + 1 IVCOMP = IVON01 IVCORR = 1 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5761 CONTINUE IVTNUM = 576 C C **** TEST 576 **** C TEST 576 - TEST OF A LOGICAL VARIABLE SET TO THE LOGICAL C CONSTANT .FALSE. THE FALSE PATH OF A LOGICAL IF STATEMENT C IS ALSO USED IN THE TEST. C C IF (ICZERO) 35760, 5760, 35760 5760 CONTINUE IVON01 = 1 IF ( LCTN02 ) IVON01 = 0 GO TO 45760 35760 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45760, 5771, 45760 45760 IF ( IVON01 - 1 ) 25760, 15760, 25760 15760 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5771 25760 IVFAIL = IVFAIL + 1 IVCOMP = IVON01 IVCORR = 1 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5771 CONTINUE IVTNUM = 577 C C **** TEST 577 **** C TEST 577 - REAL VARIABLE SET TO 0. C C IF (ICZERO) 35770, 5770, 35770 5770 CONTINUE GO TO 45770 35770 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45770, 5781, 45770 45770 IF ( RCON01 - 0. ) 25770, 15770, 25770 15770 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5781 25770 IVFAIL = IVFAIL + 1 IVCOMP = RCON01 IVCORR = 0 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5781 CONTINUE IVTNUM = 578 C C **** TEST 578 **** C TEST 578 - REAL VARIABLE SET TO .0 C C IF (ICZERO) 35780, 5780, 35780 5780 CONTINUE GO TO 45780 35780 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45780, 5791, 45780 45780 IF ( RCON02 - .0 ) 25780, 15780, 25780 15780 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5791 25780 IVFAIL = IVFAIL + 1 IVCOMP = RCON02 IVCORR = 0 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5791 CONTINUE IVTNUM = 579 C C **** TEST 579 **** C TEST 579 - REAL VARIABLE SET TO 0.0 C C IF (ICZERO) 35790, 5790, 35790 5790 CONTINUE GO TO 45790 35790 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45790, 5801, 45790 45790 IF ( RCON03 - 0.0 ) 25790, 15790, 25790 15790 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5801 25790 IVFAIL = IVFAIL + 1 IVCOMP = RCON03 IVCORR = 0 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5801 CONTINUE IVTNUM = 580 C C **** TEST 580 **** C TEST 580 - REAL VARIABLE SET TO 32767. C C IF (ICZERO) 35800, 5800, 35800 5800 CONTINUE GO TO 45800 35800 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45800, 5811, 45800 45800 IF ( RCON04 - 32767. ) 25800, 15800, 25800 15800 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5811 25800 IVFAIL = IVFAIL + 1 IVCOMP = RCON04 IVCORR = 32767 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5811 CONTINUE IVTNUM = 581 C C **** TEST 581 **** C TEST 581 - REAL VARIABLE SET TO -32766. C C IF (ICZERO) 35810, 5810, 35810 5810 CONTINUE GO TO 45810 35810 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45810, 5821, 45810 45810 IF ( RCON05 + 32766 ) 25810, 15810, 25810 15810 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5821 25810 IVFAIL = IVFAIL + 1 IVCOMP = RCON05 IVCORR = -32766 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5821 CONTINUE IVTNUM = 582 C C **** TEST 582 **** C TEST 582 - REAL VARIABLE SET TO -000587. TEST OF LEADING SIGN C AND LEADING ZEROS ON A REAL CONSTANT. C C IF (ICZERO) 35820, 5820, 35820 5820 CONTINUE GO TO 45820 35820 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45820, 5831, 45820 45820 IF ( RCON06 + 587. ) 25820, 15820, 25820 15820 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5831 25820 IVFAIL = IVFAIL + 1 IVCOMP = RCON06 IVCORR = -587 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5831 CONTINUE IVTNUM = 583 C C **** TEST 583 **** C TEST 583 - REAL VARIABLE SET TO 99.99 C C IF (ICZERO) 35830, 5830, 35830 5830 CONTINUE GO TO 45830 35830 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45830, 5841, 45830 45830 IF ( RCON07 - 99.99 ) 25830, 15830, 25830 15830 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5841 25830 IVFAIL = IVFAIL + 1 IVCOMP = RCON07 IVCORR = 99 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5841 CONTINUE IVTNUM = 584 C C **** TEST 584 **** C TEST 584 - REAL VARIABLE SET TO /-03. 2 7 6 6/ TO TEST C THE EFFECT OF BLANKS IMBEDDED IN A REAL CONSTANT. C C IF (ICZERO) 35840, 5840, 35840 5840 CONTINUE GO TO 45840 35840 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45840, 5851, 45840 45840 IF ( RCON08 + 3.2766 ) 25840, 15840, 25840 15840 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5851 25840 IVFAIL = IVFAIL + 1 IVCOMP = RCON08 IVCORR = -3 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5851 CONTINUE IVTNUM = 585 C C **** TEST 585 **** C TEST 585 - INTEGER ARRAY ELEMENT SET TO 3 C C IF (ICZERO) 35850, 5850, 35850 5850 CONTINUE GO TO 45850 35850 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45850, 5861, 45850 45850 IF ( IADN11(1) - 3 ) 25850, 15850, 25850 15850 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5861 25850 IVFAIL = IVFAIL + 1 IVCOMP = IADN11(1) IVCORR = 3 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5861 CONTINUE IVTNUM = 586 C C **** TEST 586 **** C TEST 586 - INTEGER ARRAY ELEMENT SET TO 32767 C C IF (ICZERO) 35860, 5860, 35860 5860 CONTINUE GO TO 45860 35860 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45860, 5871, 45860 45860 IF ( IADN11(2) - 32767 ) 25860, 15860, 25860 15860 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5871 25860 IVFAIL = IVFAIL + 1 IVCOMP = IADN11(2) IVCORR = 32767 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5871 CONTINUE IVTNUM = 587 C C **** TEST 587 **** C TEST 587 - INTEGER ARRAY ELEMENT SET TO -587 C C IF (ICZERO) 35870, 5870, 35870 5870 CONTINUE GO TO 45870 35870 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45870, 5881, 45870 45870 IF ( IADN11(3) + 587 ) 25870, 15870, 25870 15870 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5881 25870 IVFAIL = IVFAIL + 1 IVCOMP = IADN11(3) IVCORR = -587 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5881 CONTINUE IVTNUM = 588 C C **** TEST 588 **** C TEST 588 - TEST OF THE REPEAT FIELD /4*999/ IN A DATA STATE. C C IF (ICZERO) 35880, 5880, 35880 5880 CONTINUE GO TO 45880 35880 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45880, 5891, 45880 45880 IF ( IADN12(3) - 9999 ) 25880, 15880, 25880 15880 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5891 25880 IVFAIL = IVFAIL + 1 IVCOMP = IADN12(3) IVCORR = 9999 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5891 CONTINUE IVTNUM = 589 C C **** TEST 589 **** C TEST 589 - TEST OF SETTING THE WHOLE INTEGER ARRAY ELEMENTS C IN ONE DATA INITIALIZATION STATEMENT. THE FIRST ELEMENT C IS SET TO 0 C C IF (ICZERO) 35890, 5890, 35890 5890 CONTINUE GO TO 45890 35890 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45890, 5901, 45890 45890 IF ( IADN13(1) - 0 ) 25890, 15890, 25890 15890 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5901 25890 IVFAIL = IVFAIL + 1 IVCOMP = IADN13(1) IVCORR = 0 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5901 CONTINUE IVTNUM = 590 C C **** TEST 590 **** C TEST 590 - SEE TEST 589. THE SECOND ELEMENT WAS SET TO -32766 C C IF (ICZERO) 35900, 5900, 35900 5900 CONTINUE GO TO 45900 35900 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45900, 5911, 45900 45900 IF ( IADN13(2) + 32766 ) 25900, 15900, 25900 15900 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5911 25900 IVFAIL = IVFAIL + 1 IVCOMP = IADN13(2) IVCORR = -32766 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5911 CONTINUE IVTNUM = 591 C C **** TEST 591 **** C TEST 591 - SEE TEST 589. THE THIRD ELEMENT WAS SET TO -32766 C C IF (ICZERO) 35910, 5910, 35910 5910 CONTINUE GO TO 45910 35910 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45910, 5921, 45910 45910 IF ( IADN13(3) + 32766 ) 25910, 15910, 25910 15910 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5921 25910 IVFAIL = IVFAIL + 1 IVCOMP = IADN13(3) IVCORR = -32766 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5921 CONTINUE IVTNUM = 592 C C **** TEST 592 **** C TEST 592 - SEE TEST 589. THE FOURTH ELEMENT WAS SET TO -587 C C IF (ICZERO) 35920, 5920, 35920 5920 CONTINUE GO TO 45920 35920 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45920, 5931, 45920 45920 IF ( IADN13(4) + 587 ) 25920, 15920, 25920 15920 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5931 25920 IVFAIL = IVFAIL + 1 IVCOMP = IADN13(4) IVCORR = -587 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5931 CONTINUE IVTNUM = 593 C C **** TEST 593 **** C TEST 593 - TEST OF SETTING THE WHOLE LOGICAL ARRAY IN ONE C DATA INITIALIZATION STATEMENT. THE FIRST ELEMENT IS .TRUE. C THE SECOND AND THIRD ELEMENTS ARE .FALSE. C THE FALSE PATH OF A LOGICAL IF STATEMENT IS USED TESTING 2. C C IF (ICZERO) 35930, 5930, 35930 5930 CONTINUE IVON01 = 1 IF ( LADN11(2) ) IVON01 = 0 GO TO 45930 35930 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45930, 5941, 45930 45930 IF ( IVON01 - 1 ) 25930, 15930, 25930 15930 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5941 25930 IVFAIL = IVFAIL + 1 IVCOMP = IVON01 IVCORR = 1 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5941 CONTINUE IVTNUM = 594 C C **** TEST 594 **** C TEST 594 - SEE TEST 593. THE FOURTH ELEMENT IS TESTED C WITH THE TRUE PATH OF THE LOGICAL IF STATEMENT. C C IF (ICZERO) 35940, 5940, 35940 5940 CONTINUE IVON01 = 0 IF ( LADN11(4) ) IVON01 = 1 GO TO 45940 35940 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45940, 5951, 45940 45940 IF ( IVON01 - 1 ) 25940, 15940, 25940 15940 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5951 25940 IVFAIL = IVFAIL + 1 IVCOMP = IVON01 IVCORR = 1 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5951 CONTINUE IVTNUM = 595 C C **** TEST 595 **** C TEST 595 - A WHOLE REAL ARRAY IS SET IN ONE DATA INITIALIZATION C STATEMENT. THE SECOND ELEMENT IS -32.766 C C IF (ICZERO) 35950, 5950, 35950 5950 CONTINUE GO TO 45950 35950 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45950, 5961, 45950 45950 IF ( RADN11(2) + 32.766 ) 25950, 15950, 25950 15950 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5961 25950 IVFAIL = IVFAIL + 1 IVCOMP = RADN11(2) IVCORR = -32 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5961 CONTINUE IVTNUM = 596 C C **** TEST 596 **** C TEST 596 - SEE TEST 595. THE FOURTH ELEMENT IS SET TO 587 C BY A REPEAT FIELD. C C IF (ICZERO) 35960, 5960, 35960 5960 CONTINUE GO TO 45960 35960 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45960, 5971, 45960 45960 IF ( RADN11(4) - 587 ) 25960, 15960, 25960 15960 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5971 25960 IVFAIL = IVFAIL + 1 IVCOMP = RADN11(4) IVCORR = 587 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5971 CONTINUE IVTNUM = 597 C C **** TEST 597 **** C TEST 597 - TEST OF MIXED ARRAY ELEMENT TYPES IN A SINGLE DATA C INITIALIZATION STATEMENT. THE TYPE LOGICAL STATEMENT CONTAINS C THE ARRAY DECLARATIONS. THE FALSE PATH OF A LOGICAL C IF STATEMENT TESTS THE LOGICAL RESULTS. C C IF (ICZERO) 35970, 5970, 35970 5970 CONTINUE IVON01 = 1 IF ( LATN11(2) ) IVON01 = 0 GO TO 45970 35970 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45970, 5981, 45970 45970 IF ( IVON01 - 1 ) 25970, 15970, 25970 15970 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5981 25970 IVFAIL = IVFAIL + 1 IVCOMP = IVON01 IVCORR = 1 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5981 CONTINUE IVTNUM = 598 C C **** TEST 598 **** C TEST 598 - TYPE OF THE DATA WAS SET EXPLICITLY REAL IN THE C DECLARATIVE FOR THE ARRAY. DATA SHOULD BE SET TO 32767. C C IF (ICZERO) 35980, 5980, 35980 5980 CONTINUE GO TO 45980 35980 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45980, 5991, 45980 45980 IF ( IATN11(2) - 32767. ) 25980, 15980, 25980 15980 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 5991 25980 IVFAIL = IVFAIL + 1 IVCOMP = IATN11(2) IVCORR = 32767 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 5991 CONTINUE IVTNUM = 599 C C **** TEST 599 **** C TEST 599 - TYPE OF THE DATA WAS SET EXPLICITLY INTEGER IN THE C DECLARATIVE FOR THE ARRAY. DATA SHOULD BE SET TO -32766 C C IF (ICZERO) 35990, 5990, 35990 5990 CONTINUE GO TO 45990 35990 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 45990, 6001, 45990 45990 IF ( RATN11(2) + 32766 ) 25990, 15990, 25990 15990 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 6001 25990 IVFAIL = IVFAIL + 1 IVCOMP = RATN11(2) IVCORR = -32766 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 6001 CONTINUE IVTNUM = 600 C C **** TEST 600 **** C TEST 600 - TEST OF REAL DECIMAL CONSTANTS USING E-NOTATION. C SEE SECTION 4.4.2. THE VALUE OF THE ELEMENT SHOULD C BE SET TO 32767. C C IF (ICZERO) 36000, 6000, 36000 6000 CONTINUE GO TO 46000 36000 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 46000, 6011, 46000 46000 IF ( RADN13(1) - 32767. ) 26000, 16000, 26000 16000 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 6011 26000 IVFAIL = IVFAIL + 1 IVCOMP = RADN13(1) IVCORR = 32767 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 6011 CONTINUE IVTNUM = 601 C C **** TEST 601 **** C TEST 601 - LIKE TEST 600. REAL DECIMAL CONSTANT VALUE -.32766 C C IF (ICZERO) 36010, 6010, 36010 6010 CONTINUE GO TO 46010 36010 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 46010, 6021, 46010 46010 IF ( RADN13(2) + .32766 ) 26010, 16010, 26010 16010 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 6021 26010 IVFAIL = IVFAIL + 1 IVCOMP = RADN13(2) IVCORR = 0 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 6021 CONTINUE IVTNUM = 602 C C **** TEST 602 **** C TEST 602 - LIKE TEST 600. REAL DECIMAL CONSTANT VALUE 587. C C IF (ICZERO) 36020, 6020, 36020 6020 CONTINUE GO TO 46020 36020 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 46020, 6031, 46020 46020 IF ( RADN13(3) - 587 ) 26020, 16020, 26020 16020 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 6031 26020 IVFAIL = IVFAIL + 1 IVCOMP = RADN13(3) IVCORR = 587 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 6031 CONTINUE IVTNUM = 603 C C **** TEST 603 **** C TEST 603 - LIKE TEST 600. REAL DECIMAL CONSTANT VALUE 90. C C IF (ICZERO) 36030, 6030, 36030 6030 CONTINUE GO TO 46030 36030 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 46030, 6041, 46030 46030 IF ( RADN13(4) - 90. ) 26030, 16030, 26030 16030 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 6041 26030 IVFAIL = IVFAIL + 1 IVCOMP = RADN13(4) IVCORR = 90 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 6041 CONTINUE C C WRITE PAGE FOOTINGS AND RUN SUMMARIES 99999 CONTINUE WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90007) WRITE (I02,90002) WRITE (I02,90008) IVFAIL WRITE (I02,90009) IVPASS WRITE (I02,90010) IVDELE C C C TERMINATE ROUTINE EXECUTION STOP C C FORMAT STATEMENTS FOR PAGE HEADERS 90000 FORMAT (1H1) 90002 FORMAT (1H ) 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90003 FORMAT (1H ,21X,11HVERSION 1.0) 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 90006 FORMAT (1H ,5X,46H----------------------------------------------) 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARIES 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) C C FORMAT STATEMENTS FOR TEST RESULTS 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) C 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM021) END