PROGRAM FM352 C C C THIS PROGRAM CHECKS BASIC RELATIONAL EXPRESSIONS INVOLVING C OPERANDS OF REAL DATA TYPE. IN EACH TEST, NOT ONLY THE RELATIONAL C EXPRESSION IS TESTED, BUT THE TRICHOTOMY LAW OF MATHEMATICAL C RELATIONSHIPS IS ALSO TESTED (E.G., IF A .LT. B, THEN A CAN NOT C BE .GT. THAN B, AND A CAN NOT BE .EQ. B). A TEST VARIABLE C (IVCOMP) IS USED TO REPORT THE RESULT OF THE TEST AS FOLLOWS, C IVCOMP = 0 IF BOTH THE TESTED RELATIONAL OPERATOR AND THE C TRICHOTOMY TEST PASS. C IVCOMP = 1 IF THE RELATIONAL TEST FAILS AND THE TRICHOTOMY C TEST PASSES (WHICH WOULD INDICATE THAT A TESTED C NOT .LT., .GT., OR .EQ. B). C IVCOMP = 2 IF THE RELATIONAL TEST PASSES AND THE TRICHOTOMY C TEST FAILS (WHICH WOULD INDICATE THAT A TESTED C .LT., .GT., AND .EQ. B). C IVCOMP = 3 IF BOTH THE RELATIONAL TEST AND THE TRICHOTOMY C TEST FAIL (WHICH WOULD INDICATE THE RELATIONAL C EXPRESSION TESTED OPPOSITE TO THAT EXPECTED C (E.G., WHERE A WAS SUPPOSED TO BE .LT. B, IN C FACT A .LT. B WAS FOUND TO BE FALSE AND A .GE. B C WAS FOUND TO BE TRUE). C C C REFERENCES - C C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, X3.9-1977 C SECTION 4.4, REAL TYPE C SECTION 6.3, RELATIONAL EXPRESSIONS C SECTION 6.5, PRECEDENCE OF OPERATORS C SECTION 6.6, EVALUATION OF EXPRESSIONS C C C ****************************************************************** C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING C THE RESULT OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES C FOUND IN THE SUBSET LEVEL OF THE STANDARD. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ****************************************************************** C C IMPLICIT LOGICAL (L) IMPLICIT CHARACTER*14 (C) C DIMENSION RADN11(2) RFOS01(RDON01,RDON02) = RDON01 + RDON02 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 PEPLACED 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 PEPLACED 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 OUT PAGE HEADERS C WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90008) WRITE (I02,90004) WRITE (I02,90010) WRITE (I02,90004) WRITE (I02,90016) WRITE (I02,90001) WRITE (I02,90004) WRITE (I02,90012) WRITE (I02,90014) WRITE (I02,90004) C C C TESTS 1 THROUGH 13 CHECK BASIC RELATIONAL EXPRESSIONS USING C ONLY REAL VARIABLE OPERANDS. ALL THE VARIABLES ARE ASSIGNED REAL C CONSTANTS WITH EXPONENTIAL FORMAT. C C C **** FCVS PROGRAM 352 - TEST 001 **** C C TEST 1 CHECKS THE .LT. OPERATOR USING TWO REAL OPERANDS C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT. C IVTNUM = 1 IF (ICZERO) 30010, 0010, 30010 0010 CONTINUE RVON01 = 1.0001 E17 RVON02 = 1.0001 E18 IVCOMP = 0 IVCORR = 0 40010 IF(RVON01 .LT. RVON02) GO TO 40011 IVCOMP = 1 40011 IF (RVON01 .GE. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20010, 10010, 20010 30010 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10010, 0021, 20010 10010 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0021 20010 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0021 CONTINUE C C **** FCVS PROGRAM 352 - TEST 002 **** C C TEST 2 CHECKS THE .LT. OPERATOR USING TWO REAL OPERANDS C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT. C IVTNUM = 2 IF (ICZERO) 30020, 0020, 30020 0020 CONTINUE RVON01 = 1.0001 E17 RVON02 = 1.9999 E17 IVCOMP = 0 IVCORR = 0 40020 IF (RVON01 .LT. RVON02) GO TO 40021 IVCOMP = 1 40021 IF (RVON01 .GE. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20020, 10020, 20020 30020 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10020, 0031, 20020 10020 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0031 20020 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0031 CONTINUE C C **** FCVS PROGRAM 352 - TEST 003 **** C C TEST 3 CHECKS THE .LE. OPERATOR USING TWO REAL OPERANDS C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT. C IVTNUM = 3 IF (ICZERO) 30030, 0030, 30030 0030 CONTINUE RVON01 = 1.0001 E17 RVON02 = 1.0001 E18 IVCOMP = 0 IVCORR = 0 40030 IF (RVON01 .LE. RVON02) GO TO 40031 IVCOMP = 1 40031 IF (RVON01 .GT. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20030, 10030, 20030 30030 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10030, 0041, 20030 10030 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0041 20030 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0041 CONTINUE C C **** FCVS PROGRAM 352 - TEST 004 **** C C TEST 4 CHECKS THE .LE. OPERATOR USING TWO REAL OPERANDS C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT. C IVTNUM = 4 IF (ICZERO) 30040, 0040, 30040 0040 CONTINUE RVON01 = 1.0001 E17 RVON02 = 1.9999 E17 IVCOMP = 0 IVCORR = 0 40040 IF (RVON01 .LE. RVON02) GO TO 40041 IVCOMP = 1 40041 IF (RVON01 .GT. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20040, 10040, 20040 30040 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10040, 0051, 20040 10040 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0051 20040 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0051 CONTINUE C C **** FCVS PROGRAM 352 - TEST 005 **** C C TEST 5 CHECKS THE .LE. OPERATOR USING TWO REAL OPERANDS C WHICH HAVE BEEN ASSIGNED THE SAME REAL CONSTANT. C IVTNUM = 5 IF (ICZERO) 30050, 0050, 30050 0050 CONTINUE RVON01 = 1.0001 E17 RVON02 = 1.0001 E17 IVCOMP = 0 IVCORR = 0 40050 IF (RVON01 .LE. RVON02) GO TO 40051 IVCOMP = 1 40051 IF (RVON01 .GT. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20050, 10050, 20050 30050 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10050, 0061, 20050 10050 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0061 20050 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0061 CONTINUE C C **** FCVS PROGRAM 352 - TEST 006 **** C C TEST 6 CHECKS THE .NE. OPERATOR USING TWO REAL OPERANDS C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT. C IVTNUM = 6 IF (ICZERO) 30060, 0060, 30060 0060 CONTINUE RVON01 = 1.0001 E17 RVON02 = 1.0001 E18 IVCOMP = 0 IVCORR = 0 40060 IF (RVON01 .NE. RVON02) GO TO 40061 IVCOMP = 1 40061 IF (RVON01 .EQ. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20060, 10060, 20060 30060 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10060, 0071, 20060 10060 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0071 20060 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0071 CONTINUE C C **** FCVS PROGRAM 352 - TEST 007 **** C C TEST 7 CHECKS THE .NE. OPERATOR USING TWO REAL OPERANDS C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT. C IVTNUM = 7 IF (ICZERO) 30070, 0070, 30070 0070 CONTINUE RVON01 = 1.0001 E17 RVON02 = 1.9999 E17 IVCOMP = 0 IVCORR = 0 40070 IF (RVON01 .NE. RVON02) GO TO 40071 IVCOMP = 1 40071 IF (RVON01 .EQ. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20070, 10070, 20070 30070 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10070, 0081, 20070 10070 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0081 20070 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0081 CONTINUE C C **** FCVS PROGRAM 352 - TEST 008 **** C C TEST 8 CHECKS THE .EQ. OPERATOR USING TWO REAL OPERANDS C WHICH HAVE BEEN ASSIGNED THE SAME REAL CONSTANT. C IVTNUM = 8 IF (ICZERO) 30080, 0080, 30080 0080 CONTINUE RVON01 = 1.0001 E17 RVON02 = 1.0001 E17 IVCOMP = 0 IVCORR = 0 40080 IF (RVON01 .EQ. RVON02) GO TO 40081 IVCOMP = 1 40081 IF (RVON01 .NE. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20080, 10080, 20080 30080 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10080, 0091, 20080 10080 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0091 20080 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0091 CONTINUE C C **** FCVS PROGRAM 352 - TEST 009 **** C C TEST 9 CHECKS THE .GT. OPERATOR USING TWO REAL OPERANDS C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT. C IVTNUM = 9 IF (ICZERO) 30090, 0090, 30090 0090 CONTINUE RVON01 = 1.0001 E18 RVON02 = 1.0001 E17 IVCOMP = 0 IVCORR = 0 40090 IF(RVON01 .GT. RVON02) GO TO 40091 IVCOMP = 1 40091 IF (RVON01 .LE. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20090, 10090, 20090 30090 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10090, 0101, 20090 10090 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0101 20090 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0101 CONTINUE C C **** FCVS PROGRAM 352 - TEST 010 **** C C TEST 10 CHECKS THE .GT. OPERATOR USING TWO REAL OPERANDS C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT. C IVTNUM = 10 IF (ICZERO) 30100, 0100, 30100 0100 CONTINUE RVON01 = 1.9999 E17 RVON02 = 1.0001 E17 IVCOMP = 0 IVCORR = 0 40100 IF (RVON01 .GT. RVON02) GO TO 40101 IVCOMP = 1 40101 IF (RVON01 .LE. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20100, 10100, 20100 30100 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10100, 0111, 20100 10100 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0111 20100 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0111 CONTINUE C C **** FCVS PROGRAM 352 - TEST 011 **** C C TEST 11 CHECKS THE .GE. OPERATOR USING TWO REAL OPERANDS C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT. C IVTNUM = 11 IF (ICZERO) 30110, 0110, 30110 0110 CONTINUE RVON01 = 1.0001 E18 RVON02 = 1.0001 E17 IVCOMP = 0 IVCORR = 0 40110 IF (RVON01 .GE. RVON02) GO TO 40111 IVCOMP = 1 40111 IF (RVON01 .LT. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20110, 10110, 20110 30110 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10110, 0121, 20110 10110 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0121 20110 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0121 CONTINUE C C **** FCVS PROGRAM 352 - TEST 012 **** C C TEST 12 CHECKS THE .GE. OPERATOR USING TWO REAL OPERANDS C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT. C IVTNUM = 12 IF (ICZERO) 30120, 0120, 30120 0120 CONTINUE RVON01 = 1.9999 E17 RVON02 = 1.0001 E17 IVCOMP = 0 IVCORR = 0 40120 IF (RVON01 .GE. RVON02) GO TO 40121 IVCOMP = 1 40121 IF (RVON01 .LT. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20120, 10120, 20120 30120 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10120, 0131, 20120 10120 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0131 20120 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0131 CONTINUE C C **** FCVS PROGRAM 352 - TEST 013 **** C C TEST 13 CHECKS THE .GE. OPERATOR USING TWO REAL OPERANDS C WHERE EACH HAS BEEN ASSIGNED THE SAME REAL CONSTANT. C IVTNUM = 13 IF (ICZERO) 30130, 0130, 30130 0130 CONTINUE RVON01 = 1.0001 E17 RVON02 = 1.0001 E17 IVCOMP = 0 IVCORR = 0 40130 IF (RVON01 .GE. RVON02) GO TO 40131 IVCOMP = 1 40131 IF (RVON01 .LT. RVON02) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20130, 10130, 20130 30130 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10130, 0141, 20130 10130 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0141 20130 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0141 CONTINUE C C TESTS 14 THROUGH 28 REPETITIVELY CHECK THE .LT. RELATIONSHIP C USING ALL TYPES AND ORDERINGS OF TWO REAL OPERANDS. C C C TESTS 14 THROUGH 16 CHECK REAL-VARIABLE .LT OTHER-REAL-TYPES. C C C **** FCVS PROGRAM 352 - TEST 014 **** C C TEST 14 CHECKS REAL-VARIABLE .LT. REAL-CONSTANT C IVTNUM = 14 IF (ICZERO) 30140, 0140, 30140 0140 CONTINUE RVON01 = 1.0001 E17 IVCOMP = 0 IVCORR = 0 40140 IF (RVON01 .LT. 1.9999 E17) GO TO 40141 IVCOMP = 1 40141 IF (RVON01 .GE. 1.9999 E17) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20140, 10140, 20140 30140 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10140, 0151, 20140 10140 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0151 20140 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0151 CONTINUE C C **** FCVS PROGRAM 352 - TEST 015 **** C C TEST 15 CHECKS REAL-VARIABLE .LT. ARRAY-ELEMENT C IVTNUM = 15 IF (ICZERO) 30150, 0150, 30150 0150 CONTINUE RADN11(1) = 1.9999 E17 RVON01 = 1.0001 E17 IVCOMP = 0 IVCORR = 0 40150 IF (RVON01 .LT. RADN11(1)) GO TO 40151 IVCOMP = 1 40151 IF (RVON01 .GE. RADN11(1)) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20150, 10150, 20150 30150 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10150, 0161, 20150 10150 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0161 20150 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0161 CONTINUE C C **** FCVS PROGRAM 352 - TEST 016 **** C C TEST 16 CHECKS REAL-VARIABLE .LT. FUNCTION-REFERENCE C IVTNUM = 16 IF (ICZERO) 30160, 0160, 30160 0160 CONTINUE RVON01 = 1.0001 E17 RVON02 = 1 E17 RVON03 = 0.9999 E17 IVCOMP = 0 IVCORR = 0 40160 IF (RVON01 .LT. RFOS01(RVON02,RVON03)) GO TO 40161 IVCOMP = 1 40161 IF (RVON01 .GE. RFOS01(RVON02,RVON03)) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20160, 10160, 20160 30160 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10160, 0171, 20160 10160 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0171 20160 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0171 CONTINUE C C TESTS 17 THROUGH 20 CHECK REAL-CONSTANT .LT. OTHER-REAL-TYPES C C C **** FCVS PROGRAM 352 - TEST 017 **** C C TEST 17 CHECKS REAL-CONSTANT .LT. REAL-CONSTANT C IVTNUM = 17 IF (ICZERO) 30170, 0170, 30170 0170 CONTINUE IVCOMP = 0 IVCORR = 0 40170 IF (1.0001 E17 .LT. 1.9999 E17) GO TO 40171 IVCOMP = 1 40171 IF (1.0001 E17 .GE. 1.9999 E17) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20170, 10170, 20170 30170 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10170, 0181, 20170 10170 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0181 20170 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0181 CONTINUE C C **** FCVS PROGRAM 352 - TEST 018 **** C C TEST 18 CHECKS REAL-CONSTANT .LT. REAL-ARRAY-ELEMENT C IVTNUM = 18 IF (ICZERO) 30180, 0180, 30180 0180 CONTINUE RADN11(1) = 1.9999 E17 IVCOMP = 0 IVCORR = 0 40180 IF (1.0001 E17 .LT. RADN11(1)) GO TO 40181 IVCOMP = 1 40181 IF (1.0001 E17 .GE. RADN11(1)) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20180, 10180, 20180 30180 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10180, 0191, 20180 10180 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0191 20180 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0191 CONTINUE C C **** FCVS PROGRAM 352 - TEST 019 **** C C TEST 19 CHECKS REAL-CONSTANT .LT. REAL-VARIABLE C IVTNUM = 19 IF (ICZERO) 30190, 0190, 30190 0190 CONTINUE RVON01 = 1.9999 E17 IVCOMP = 0 IVCORR = 0 40190 IF (1.0001 E17 .LT. RVON01) GO TO 40191 IVCOMP = 1 40191 IF (1.0001 E17 .GE. RVON01) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20190, 10190, 20190 30190 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10190, 0201, 20190 10190 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0201 20190 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0201 CONTINUE C C **** FCVS PROGRAM 352 - TEST 020 **** C C TEST 20 CHECKS REAL-CONSTANT .LT. REAL-FUNCTION-REFERENCE C IVTNUM = 20 IF (ICZERO) 30200, 0200, 30200 0200 CONTINUE RVON01 = 1 E17 RVON02 = 0.9999 E17 IVCOMP = 0 IVCORR = 0 40200 IF (1.0001 E17 .LT. RFOS01(RVON01,RVON02)) GO TO 40201 IVCOMP = 1 40201 IF (1.0001 E17 .GE. RFOS01(RVON01,RVON02)) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20200, 10200, 20200 30200 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10200, 0211, 20200 10200 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0211 20200 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0211 CONTINUE C C TESTS 21 THROUGH 24 CHECK REAL-ARRAY-ELEMENT .LT. OTHER-REALS C C C **** FCVS PROGRAM 352 - TEST 021 **** C C TEST 21 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-CONSTANT C IVTNUM = 21 IF (ICZERO) 30210, 0210, 30210 0210 CONTINUE RADN11(1) = 1.0001 E17 IVCOMP = 0 IVCORR = 0 40210 IF (RADN11(1) .LT. 1.9999 E17) GO TO 40211 IVCOMP = 1 40211 IF (RADN11(1) .GE. 1.9999 E17) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20210, 10210, 20210 30210 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10210, 0221, 20210 10210 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0221 20210 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0221 CONTINUE C C **** FCVS PROGRAM 352 - TEST 022 **** C C TEST 22 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-ARRAY-ELEMENT C IVTNUM = 22 IF (ICZERO) 30220, 0220, 30220 0220 CONTINUE RADN11(1) = 1.0001 E17 RADN11(2) = 1.9999 E17 IVCOMP = 0 IVCORR = 0 40220 IF (RADN11(1) .LT. RADN11(2)) GO TO 40221 IVCOMP = 1 40221 IF (RADN11(1) .GE. RADN11(2)) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20220, 10220, 20220 30220 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10220, 0231, 20220 10220 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0231 20220 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0231 CONTINUE C C **** FCVS PROGRAM 352 - TEST 023 **** C C TEST 23 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-VARIABLE C IVTNUM = 23 IF (ICZERO) 30230, 0230, 30230 0230 CONTINUE RVON01 = 1.9999 E17 RADN11(1) = 1.0001 E17 IVCORR = 0 IVCOMP = 0 40230 IF (RADN11(1) .LT. RVON01) GO TO 40231 IVCOMP = 1 40231 IF (RADN11(1) .GE. RVON01) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20230, 10230, 20230 30230 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10230, 0241, 20230 10230 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0241 20230 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0241 CONTINUE C C **** FCVS PROGRAM 352 - TEST 024 **** C C TEST 24 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-FUNCTION-REF. C IVTNUM = 24 IF (ICZERO) 30240, 0240, 30240 0240 CONTINUE RVON01 = 1.0000 E17 RVON02 = 0.9999 E17 RADN11(1) = 1.0001 E17 IVCORR = 0 IVCOMP = 0 40240 IF (RADN11(1) .LT. RFOS01(RVON01,RVON02)) GO TO 40241 IVCOMP = 1 40241 IF (RADN11(1) .GE. RFOS01(RVON01,RVON02)) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20240, 10240, 20240 30240 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10240, 0251, 20240 10240 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0251 20240 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0251 CONTINUE C C TESTS 25 THROUGH 28 CHECK REAL-FUNCTION-REFERENCE .LT. C OTHER-REAL-TYPES C C C **** FCVS PROGRAM 352 - TEST 025 **** C C TEST 25 CHECKS REAL-FUNCTION-REFERENCE .LT. REAL-CONSTANT C IVTNUM = 25 IF (ICZERO) 30250, 0250, 30250 0250 CONTINUE RVON01 = 1.0000 E17 RVON02 = 0.0001 E17 IVCOMP = 0 IVCORR = 0 40250 IF (RFOS01(RVON01,RVON02) .LT. 1.9999 E17) GO TO 40251 IVCOMP = 1 40251 IF (RFOS01(RVON01,RVON02) .GE. 1.9999 E17) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20250, 10250, 20250 30250 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10250, 0261, 20250 10250 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0261 20250 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0261 CONTINUE C C **** FCVS PROGRAM 352 - TEST 026 **** C C TEST 26 CHECKS REAL-FUNCTION-REFERENCE .LT. REAL-ARRAY-ELEMNT C IVTNUM = 26 IF (ICZERO) 30260, 0260, 30260 0260 CONTINUE RVON01 = 1 E17 RVON02 = 0.0001 E17 RADN11(1) = 1.9999 E17 IVCOMP = 0 IVCORR = 0 40260 IF (RFOS01(RVON01,RVON02) .LT. RADN11(1)) GO TO 40261 IVCOMP = 1 40261 IF (RFOS01(RVON01,RVON02) .GE. RADN11(1)) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20260, 10260, 20260 30260 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10260, 0271, 20260 10260 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0271 20260 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0271 CONTINUE C C **** FCVS PROGRAM 352 - TEST 027 **** C C TEST 27 CHECKS REAL-FUNCTION-REFERENCE .LT. REAL-VARIABLE C IVTNUM = 27 IF (ICZERO) 30270, 0270, 30270 0270 CONTINUE RVON01 = 1 E17 RVON02 = 0.0001 E17 RVON03 = 1.9999 E17 IVCOMP = 0 IVCORR = 0 40270 IF (RFOS01(RVON01,RVON02) .LT. RVON03) GO TO 40271 IVCOMP = 1 40271 IF (RFOS01(RVON01,RVON02) .GE. RVON03) IVCOMP = IVCOMP + 2 IF (IVCOMP) 20270, 10270, 20270 30270 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10270, 0281, 20270 10270 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0281 20270 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0281 CONTINUE C C **** FCVS PROGRAM 352 - TEST 028 **** C C TEST 28 CHECKS REAL-FUNCTION-REFERENCE .LT REAL-FUNCTION-REF. C IVTNUM = 28 IF (ICZERO) 30280, 0280, 30280 0280 CONTINUE RVON01 = 1 E17 RVON02 = 0.0001 E17 RVON03 = 0.9999 E17 IVCOMP = 0 IVCORR = 0 40280 IF (RFOS01(RVON01,RVON02) .LT. RFOS01(RVON01,RVON03)) GO TO 40281 IVCOMP = 1 40281 IF (RFOS01(RVON01,RVON02) .GE. RFOS01(RVON01,RVON03)) 1 IVCOMP = IVCOMP + 2 IF (IVCOMP) 20280, 10280, 20280 30280 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10280, 0291, 20280 10280 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0291 20280 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0291 CONTINUE C C C WRITE OUT TEST SUMMARY C WRITE (I02,90004) WRITE (I02,90014) WRITE (I02,90004) WRITE (I02,90000) WRITE (I02,90004) WRITE (I02,90020) IVFAIL WRITE (I02,90022) IVPASS WRITE (I02,90024) IVDELE STOP 90001 FORMAT (1H ,24X,5HFM352) 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM352) C C FORMATS FOR TEST DETAIL LINES C 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) C C FORMAT STATEMENTS FOR PAGE HEADERS C 90002 FORMAT (1H1) 90004 FORMAT (1H ) 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90008 FORMAT (1H ,21X,11HVERSION 1.0) 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 90014 FORMAT (1H ,5X,46H----------------------------------------------) 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARY C 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) END