C COMMENT SECTION C C FM060 C C THIS ROUTINE CONTAINS BASIC ARITHMETIC IF STATEMENT TESTS FOR C THE FORMAT C C IF (E) K1,K2,K3 C C WHERE E IS A SIMPLE REAL EXPRESSION OF THE FORM C C REAL VARIABLE C REAL VARIABLE - REAL CONSTANT C REAL VARIABLE + REAL CONSTANT C C AND K1, K2 AND K3 ARE STATEMENT LABELS. C C THIS ROUTINE ALSO TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF C THE FORM C REAL VARIABLE = REAL CONSTANT C REAL VARIABLE = REAL VARIABLE C REAL VARIABLE = -REAL VARIABLE C C THE REAL CONSTANTS AND REAL VARIABLES CONTAIN BOTH POSITIVE AND C NEGATIVE VALUES. C C A REAL DATUM IS A PROCESSOR APPROXIMATION TO THE VALUE OF A C REAL NUMBER. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES. C C A BASIC REAL CONSTANT IS WRITTEN AS AN INTEGER PART, A DECIMAL C POINT, AND A DECIMAL FRACTION PART IN THAT ORDER. BOTH THE C INTEGER PART AND THE DECIMAL PART ARE STRINGS OF DIGITS; EITHER C ONE OF THESE STRINGS MAY BE EMPTY BUT NOT BOTH. THE CONSTANT IS C AN APPROXIMATION TO THE DIGIT STRING INTERPRETED AS A DECIMAL C NUMERAL. C C A DECIMAL EXPONENT IS WRITTEN AS THE LETTER E, FOLLOWED BY AN C OPTIONALLY SIGNED INTEGER CONSTANT. C C A REAL CONSTANT IS INDICATED BY WRITING A BASIC REAL CONSTANT, C A BASIC REAL CONSTANT FOLLOWED BY A DECIMAL EXPONENT, OR AN C INTEGER CONSTANT FOLLOWED BY A DECIMAL EXPONENT. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 4.4, REAL TYPE C SECTION 4.4.1, REAL CONSTANT C SECTION 6.1, ARITHMETIC EXPRESSIONS C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT C SECTION 11.4, ARITHMETIC IF STATEMENT 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) C C TEST SECTION C C ARITHMETIC IF STATEMENT C C TEST 1 THROUGH TEST 3 CONTAIN BASIC ARITHMETIC IF STATEMENT TESTS C WITH A REAL VARIABLE AS ARITHMETIC EXPRESSION. C 11 CONTINUE IVTNUM = 1 C C **** TEST 1 **** C TEST 001 - LESS THAN ZERO BRANCH EXPECTED C IF (ICZERO) 30010, 10, 30010 10 CONTINUE RVCOMP = 0.0 RVON01 = -1.0 IF (RVON01) 12,40010, 40010 12 RVCOMP = RVON01 GO TO 40010 30010 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40010, 21, 40010 40010 IF (RVCOMP) 10010,20010,20010 10010 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 21 20010 IVFAIL = IVFAIL + 1 RVCORR = -1.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 21 CONTINUE IVTNUM = 2 C C **** TEST 2 **** C TEST 002 - EQUAL TO ZERO BRANCH EXPECTED C IF (ICZERO) 30020, 20, 30020 20 CONTINUE RVCOMP = 1.0 RVON01 = 0.0 IF (RVON01) 40020,22,40020 22 RVCOMP = RVON01 GO TO 40020 30020 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40020, 31, 40020 40020 IF (RVCOMP) 20020,10020,20020 10020 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 31 20020 IVFAIL = IVFAIL + 1 RVCORR = 0.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 31 CONTINUE IVTNUM = 3 C C **** TEST 3 **** C TEST 003 - GREATER THAN ZERO BRANCH EXPECTED C IF (ICZERO) 30030, 30, 30030 30 CONTINUE RVCOMP = 0.0 RVON01 = 1.0 IF (RVON01) 40030,40030,32 32 RVCOMP = RVON01 GO TO 40030 30030 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40030, 41, 40030 40030 IF (RVCOMP) 20030,20030,10030 10030 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 41 20030 IVFAIL = IVFAIL + 1 RVCORR = 1.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 41 CONTINUE IVTNUM = 4 C C **** TEST 4 **** C TEST 004 - BASIC IF STATEMENTS TEST C THESE IF STATEMENTS ARE USED IN REAL VARIABLE TEST C VERIFICATION. THE ARITHMETIC EXPRESSIONS ARE OF THE FORM C REAL VARIABLE - REAL CONSTANT C IF (ICZERO) 30040, 40, 30040 40 CONTINUE RVCOMP = 4.0 RVON01 = 1.0 IF (RVON01 - .99995) 40040,42,42 42 IF (RVON01 - 1.0005) 43,43,40040 43 RVCOMP = 0.0 GO TO 40040 30040 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40040, 51, 40040 40040 IF (RVCOMP) 20040,10040,20040 10040 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 51 20040 IVFAIL = IVFAIL + 1 RVCORR = 0.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 51 CONTINUE IVTNUM = 5 C C **** TEST 5 **** C TEST 005 - BASIC IF STATEMENTS TEST C THESE IF STATEMENTS ARE USED IN REAL VARIABLE TEST C VERIFICATION. THE ARITHMETIC EXPRESSIONS ARE OF THE FORM C REAL VARIABLE + REAL CONSTANT C IF (ICZERO) 30050, 50, 30050 50 CONTINUE RVCOMP = -1.0 RVON01 = -1.0 IF (RVON01 + 1.0005) 40050,52,52 52 IF (RVON01 + .99995) 53,53,40050 53 RVCOMP = 0.0 GO TO 40050 30050 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40050, 61, 40050 40050 IF (RVCOMP) 20050,10050,20050 10050 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 61 20050 IVFAIL = IVFAIL + 1 RVCORR = 0.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR C C ARITHMETIC ASSIGNMENT STATEMENT C C C TEST 006 THROUGH TEST 025 CONTAIN ARITHMETIC ASSIGNMENT C STATEMENTS OF THE FORM C REAL VARIABLE = REAL CONSTANT C C THE THREE TYPES OF REAL CONSTANTS ARE TESTED WITH POSITIVE C AND NEGATIVE VALUES FOR THE CONSTANTS, AND POSITIVE AND NEGATIVE C EXPONENTS. C C TEST 006 THROUGH TEST 011 - CONSTANT IS BASIC REAL CONSTANT C 61 CONTINUE IVTNUM = 6 C C **** TEST 6 **** C IF (ICZERO) 30060, 60, 30060 60 CONTINUE RVCOMP = 2.0 GO TO 40060 30060 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40060, 71, 40060 40060 IF (RVCOMP - 1.9995) 20060,10060,40061 40061 IF (RVCOMP - 2.0005) 10060,10060,20060 10060 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 71 20060 IVFAIL = IVFAIL + 1 RVCORR = 2.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 71 CONTINUE IVTNUM = 7 C C **** TEST 7 **** C IF (ICZERO) 30070, 70, 30070 70 CONTINUE RVCOMP = 44.5 GO TO 40070 30070 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40070, 81, 40070 40070 IF (RVCOMP - 44.495) 20070,10070,40071 40071 IF (RVCOMP - 45.505) 10070,10070,20070 10070 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 81 20070 IVFAIL = IVFAIL + 1 RVCORR = 44.5 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 81 CONTINUE IVTNUM = 8 C C **** TEST 8 **** C IF (ICZERO) 30080, 80, 30080 80 CONTINUE RVCOMP = -2.0 GO TO 40080 30080 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40080, 91, 40080 40080 IF (RVCOMP + 2.0005) 20080,10080,40081 40081 IF (RVCOMP + 1.9995) 10080,10080,20080 10080 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 91 20080 IVFAIL = IVFAIL + 1 RVCORR = -2.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 91 CONTINUE IVTNUM = 9 C C **** TEST 9 **** C IF (ICZERO) 30090, 90, 30090 90 CONTINUE RVCOMP = 65001. GO TO 40090 30090 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40090, 101, 40090 40090 IF (RVCOMP - 64996.) 20090,10090,40091 40091 IF (RVCOMP - 65006.) 10090,10090,20090 10090 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 101 20090 IVFAIL = IVFAIL + 1 RVCORR = 65001. WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 101 CONTINUE IVTNUM = 10 C C **** TEST 10 **** C IF (ICZERO) 30100, 100, 30100 100 CONTINUE RVCOMP = .65001 GO TO 40100 30100 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40100, 111, 40100 40100 IF (RVCOMP - .64996) 20100,10100,40101 40101 IF (RVCOMP - .65006) 10100,10100,20100 10100 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 111 20100 IVFAIL = IVFAIL + 1 RVCORR = .65001 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 111 CONTINUE IVTNUM = 11 C C **** TEST 11 **** C IF (ICZERO) 30110, 110, 30110 110 CONTINUE RVCOMP = -.33333 GO TO 40110 30110 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40110, 121, 40110 40110 IF (RVCOMP + .33338) 20110,10110,40111 40111 IF (RVCOMP + .33328) 10110,10110,20110 10110 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 121 20110 IVFAIL = IVFAIL + 1 RVCORR = -.33333 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR C C TEST 012 THROUGH TEST 19 - REAL CONSTANT IS BASIC REAL CONSTANT C - FOLLOWED BY DECIMAL EXPONENT C 121 CONTINUE IVTNUM = 12 C C **** TEST 12 **** C IF (ICZERO) 30120, 120, 30120 120 CONTINUE RVCOMP = .2E+1 GO TO 40120 30120 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40120, 131, 40120 40120 IF (RVCOMP - 1.9995) 20120,10120,40121 40121 IF (RVCOMP - 2.0005) 10120,10120,20120 10120 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 131 20120 IVFAIL = IVFAIL + 1 RVCORR = 2.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 131 CONTINUE IVTNUM = 13 C C **** TEST 13 **** C IF (ICZERO) 30130, 130, 30130 130 CONTINUE RVCOMP = 2.0E+0 GO TO 40130 30130 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40130, 141, 40130 40130 IF (RVCOMP - 1.9995) 20130,10130,40131 40131 IF (RVCOMP - 2.0005) 10130,10130,20130 10130 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 141 20130 IVFAIL = IVFAIL + 1 RVCORR = 2.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 141 CONTINUE IVTNUM = 14 C C **** TEST 14 **** C IF (ICZERO) 30140, 140, 30140 140 CONTINUE RVCOMP = 445.0E-01 GO TO 40140 30140 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40140, 151, 40140 40140 IF (RVCOMP - 44.495) 20140,10140,40141 40141 IF (RVCOMP - 44.505) 10140,10140,20140 10140 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 151 20140 IVFAIL = IVFAIL + 1 RVCORR = 44.5 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 151 CONTINUE IVTNUM = 15 C C **** TEST 15 **** C IF (ICZERO) 30150, 150, 30150 150 CONTINUE RVCOMP = 4.450E1 GO TO 40150 30150 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40150, 161, 40150 40150 IF (RVCOMP - 44.495) 20150,10150,40151 40151 IF (RVCOMP - 44.505) 10150,10150,20150 10150 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 161 20150 IVFAIL = IVFAIL + 1 RVCORR = 44.5 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 161 CONTINUE IVTNUM = 16 C C **** TEST 16 **** C IF (ICZERO) 30160, 160, 30160 160 CONTINUE RVCOMP = 2.E+15 GO TO 40160 30160 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40160, 171, 40160 40160 IF (RVCOMP - 1.9995E+15) 20160,10160,40161 40161 IF (RVCOMP - 2.0005E+15) 10160,10160,20160 10160 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 171 20160 IVFAIL = IVFAIL + 1 RVCORR = 2.0E+15 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 171 CONTINUE IVTNUM = 17 C C **** TEST 17 **** C IF (ICZERO) 30170, 170, 30170 170 CONTINUE RVCOMP = 44.5E-15 GO TO 40170 30170 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40170, 181, 40170 40170 IF (RVCOMP - 44.495E-15) 20170,10170,40171 40171 IF (RVCOMP - 44.505E-15) 10170,10170,20170 10170 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 181 20170 IVFAIL = IVFAIL + 1 RVCORR = 44.5E-15 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 181 CONTINUE IVTNUM = 18 C C **** TEST 18 **** C IF (ICZERO) 30180, 180, 30180 180 CONTINUE RVCOMP = -4.45E0 GO TO 40180 30180 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40180, 191, 40180 40180 IF (RVCOMP + 4.4505) 20180,10180,40181 40181 IF (RVCOMP + 4.4495) 10180,10180,20180 10180 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 191 20180 IVFAIL = IVFAIL + 1 RVCORR = -4.45 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 191 CONTINUE IVTNUM = 19 C C **** TEST 19 **** C IF (ICZERO) 30190, 190, 30190 190 CONTINUE RVCOMP = -6511.8E-0 GO TO 40190 30190 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40190, 201, 40190 40190 IF (RVCOMP + 6512.3) 20190,10190,40191 40191 IF (RVCOMP + 6511.3) 10190,10190,20190 10190 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 201 20190 IVFAIL = IVFAIL + 1 RVCORR = -6511.8 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR C C TEST 020 THROUGH TEST 025 - INTEGER CONSTANT FOLLOWED C - BY A DECIMAL EXPONENT C 201 CONTINUE IVTNUM = 20 C C **** TEST 20 **** C IF (ICZERO) 30200, 200, 30200 200 CONTINUE RVCOMP = 2E+1 GO TO 40200 30200 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40200, 211, 40200 40200 IF (RVCOMP - 19.995) 20200,10200,40201 40201 IF (RVCOMP - 20.005) 10200,10200,20200 10200 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 211 20200 IVFAIL = IVFAIL + 1 RVCORR = 20.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 211 CONTINUE IVTNUM = 21 C C **** TEST 21 **** C IF (ICZERO) 30210, 210, 30210 210 CONTINUE RVCOMP = 445E-02 GO TO 40210 30210 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40210, 221, 40210 40210 IF (RVCOMP - 4.4495) 20210,10210,40211 40211 IF (RVCOMP - 4.4505) 10210,10210,20210 10210 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 221 20210 IVFAIL = IVFAIL + 1 RVCORR = 4.45 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 221 CONTINUE IVTNUM = 22 C C **** TEST 22 **** C IF (ICZERO) 30220, 220, 30220 220 CONTINUE RVCOMP = 7E3 GO TO 40220 30220 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40220, 231, 40220 40220 IF (RVCOMP - 6999.0) 20220,10220,40221 40221 IF (RVCOMP - 7001.0) 10220,10220,20220 10220 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 231 20220 IVFAIL = IVFAIL + 1 RVCORR = 7000.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 231 CONTINUE IVTNUM = 23 C C **** TEST 23 **** C IF (ICZERO) 30230, 230, 30230 230 CONTINUE RVCOMP = 214 E 0 GO TO 40230 30230 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40230, 241, 40230 40230 IF (RVCOMP - 213.95) 20230,10230,40231 40231 IF (RVCOMP - 214.05) 10230,10230,20230 10230 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 241 20230 IVFAIL = IVFAIL + 1 RVCORR = 214.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 241 CONTINUE IVTNUM = 24 C C **** TEST 24 **** C IF (ICZERO) 30240, 240, 30240 240 CONTINUE RVCOMP = -3276E+6 GO TO 40240 30240 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40240, 251, 40240 40240 IF (RVCOMP + .32765E+10) 20240,10240,40241 40241 IF (RVCOMP + .32755E+10) 10240,10240,20240 10240 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 251 20240 IVFAIL = IVFAIL + 1 RVCORR = -3276E+6 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 251 CONTINUE IVTNUM = 25 C C **** TEST 25 **** C IF (ICZERO) 30250, 250, 30250 250 CONTINUE RVCOMP = -7E3 GO TO 40250 30250 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40250, 261, 40250 40250 IF (RVCOMP + 7001.) 20250,10250,40251 40251 IF (RVCOMP + 6999.) 10250,10250,20250 10250 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 261 20250 IVFAIL = IVFAIL + 1 RVCORR = -7000.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR C C TEST 026 THROUGH TEST 028 CONTAIN ARITHMETIC ASSIGNMENT STATEMENT C OF THE FORM REAL VARIABLE = REAL VARIABLE C 261 CONTINUE IVTNUM = 26 C C **** TEST 26 **** C IF (ICZERO) 30260, 260, 30260 260 CONTINUE RVON01 = .2E+1 RVCOMP = RVON01 GO TO 40260 30260 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40260, 271, 40260 40260 IF (RVCOMP - 1.9995) 20260,10260,40261 40261 IF (RVCOMP - 2.0005) 10260,10260,20260 10260 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 271 20260 IVFAIL = IVFAIL + 1 RVCORR = 20.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 271 CONTINUE IVTNUM = 27 C C **** TEST 27 **** C IF (ICZERO) 30270, 270, 30270 270 CONTINUE RVON01 = -445.E-01 RVCOMP = RVON01 GO TO 40270 30270 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40270, 281, 40270 40270 IF (RVCOMP + 44.505) 20270,10270,40271 40271 IF (RVCOMP + 44.495) 10270,10270,20270 10270 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 281 20270 IVFAIL = IVFAIL + 1 RVCORR = -44.5 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 281 CONTINUE IVTNUM = 28 C C **** TEST 28 **** C IF (ICZERO) 30280, 280, 30280 280 CONTINUE RVON01 = 7E3 RVCOMP = RVON01 GO TO 40280 30280 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40280, 291, 40280 40280 IF (RVCOMP - 6999.0) 20280,10280,40281 40281 IF (RVCOMP-7001.0) 10280,10280,20280 10280 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 291 20280 IVFAIL = IVFAIL + 1 RVCORR = 7000.0 C C TEST 029 THROUGH TEST 031 CONTAIN ARITHMETIC ASSIGNMENT STATEMENT C OF THE FORM REAL VARIABLE = - REAL VARIABLE C WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 291 CONTINUE IVTNUM = 29 C C **** TEST 29 **** C IF (ICZERO) 30290, 290, 30290 290 CONTINUE RVON01 = .2E+1 RVCOMP = -RVON01 GO TO 40290 30290 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40290, 301, 40290 40290 IF (RVCOMP + 2.0005) 20290,10290,40291 40291 IF (RVCOMP + 1.9995) 10290,10290,20290 10290 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 301 20290 IVFAIL = IVFAIL + 1 RVCORR = -2.0 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 301 CONTINUE IVTNUM = 30 C C **** TEST 30 **** C IF (ICZERO) 30300, 300, 30300 300 CONTINUE RVON01 = -445.E-01 RVCOMP = -RVON01 GO TO 40300 30300 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40300, 311, 40300 40300 IF (RVCOMP - 44.495) 20300,10300,40301 40301 IF (RVCOMP - 44.505) 10300,10300,20300 10300 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 311 20300 IVFAIL = IVFAIL + 1 RVCORR = 44.5 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 311 CONTINUE IVTNUM = 31 C C **** TEST 31 **** C IF (ICZERO) 30310, 310, 30310 310 CONTINUE RVON01 = -.44559E1 RVCOMP = -RVON01 GO TO 40310 30310 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 40310, 321, 40310 40310 IF (RVCOMP - 4.4554) 20310,10310,40311 40311 IF (RVCOMP - 4.4564) 10310,10310,20310 10310 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 321 20310 IVFAIL = IVFAIL + 1 RVCORR = 4.4559 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR C **** END OF TESTS **** 321 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 FM060) END