PROGRAM FM255 C C C C THIS ROUTINE IS A TEST OF THE ELSE STATEMENT. TESTS WITHIN C THIS ROUTINE ARE FOR THE SYNTAX OF THE BASIC ELSE STATEMENT AND C ELSE BLOCK STRUCTURES. THE END IF STATEMENT IS USED IN ALL BLOCK C IF STRUCTURES FOR THE ROUTINES FM253, FM254, AND FM255. FOR EACH C BLOCK IF STATEMENT, THERE MUST BE A CORRESPONDING END IF STATEMENT C IN THE SAME PROGRAM UNIT. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1977 C SECTION 11.8, ELSE STATEMENT C SECTION 11.8.1, ELSE BLOCK C SECTION 11.8.2, EXECUTION OF AN ELSE STATEMENT C SECTION 11.9, END IF STATEMENT C C 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 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 C THE SYNTAX OF THE ELSE STATEMENTS IN THE TESTS TO FOLLOW IS C C IF ( E1 ) THEN C IF-BLOCK C ELSE C ELSE-BLOCK C END IF C C THE NEXT TWO TESTS WILL USE THE FOLLOWING COMBINATIONS OF TRUE C AND FALSE FOR E1 AS SHOWN BELOW - C TEST NUMBER 1 2 C E1 T F C C C C **** FCVS PROGRAM 255 - TEST 001 **** C C TEST 001 USES A VALUE OF .TRUE. FOR E1. THE IF-BLOCK SHOULD BE C EXECUTED. THE ELSE-BLOCK SHOULD NOT BE EXECUTED. C C IVTNUM = 1 IF (ICZERO) 30010, 0010, 30010 0010 CONTINUE IVCOMP = 1 IF ( .TRUE. ) THEN IVCOMP = IVCOMP * 2 ELSE IVCOMP = IVCOMP * 3 END IF C C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 **** C IVCORR = 2 40010 IF ( IVCOMP - 2 ) 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 255 - TEST 002 **** C C TEST 002 HAS E1 AS FALSE. THE IF-BLOCK SHOULD NOT BE EXECUTED. C THE ELSE-BLOCK SHOULD EXECUTE. C C IVTNUM = 2 IF (ICZERO) 30020, 0020, 30020 0020 CONTINUE IVCOMP = 1 LVON01 = .FALSE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 ELSE IVCOMP = IVCOMP * 3 END IF C C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 **** C IVCORR = 3 40020 IF ( IVCOMP - 3 ) 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 255 - TEST 003 **** C C TEST 003 HAS AN EMPTY ELSE-BLOCK. SECTION 11.8.1 STATES THAT C AN ELSE-BLOCK MAY BE EMPTY. IN THIS TEST THE VALUE OF E1 IS TRUE. C THE IF-BLOCK SHOULD BE EXECUTED. C C IVTNUM = 3 IF (ICZERO) 30030, 0030, 30030 0030 CONTINUE IVCOMP = 1 LVON01 = .TRUE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 ELSE END IF C C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 **** C IVCORR = 2 40030 IF ( IVCOMP - 2 ) 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 255 - TEST 004 **** C C TEST 004 IS SIMILAR TO THE PREVIOUS TEST EXCEPT THAT THE VALUE C OF E1 IS FALSE. THE IF-BLOCK SHOULD NOT BE EXECUTED. C C IVTNUM = 4 IF (ICZERO) 30040, 0040, 30040 0040 CONTINUE IVCOMP = 1 LVON01 = .FALSE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 ELSE END IF IVCORR = 1 40040 IF ( IVCOMP - 1 ) 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 255 - TEST 005 **** C C TEST 005 USES AN ELSE STATEMENT IN AN IF-LEVEL OF 2. THE C SYNTAX FOR THIS STRUCTURE IS SHOWN BELOW - C C IF ( E1 ) THEN C IF-BLOCK 1 C IF ( E2 ) THEN C IF-BLOCK 2 C ELSE C ELSE-BLOCK 1 C END IF C ELSE C ELSE-BLOCK 2 C END IF C C IN THIS TEST THE VALUES FOR E1 AND E2 ARE BOTH TRUE. IF-BLOCK C 1 AND IF-BLOCK 2 SHOULD BE EXECUTED. ELSE-BLOCKS 1 AND 2 SHOULD C NOT BE EXECUTED. C C IVTNUM = 5 IF (ICZERO) 30050, 0050, 30050 0050 CONTINUE IVCOMP = 1 LVON01 = .TRUE. LVON02 = .TRUE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 IF ( LVON02 ) THEN IVCOMP = IVCOMP * 3 ELSE IVCOMP = IVCOMP * 5 END IF ELSE IVCOMP = IVCOMP * 7 END IF C C **** IVCOMP IS DETERMINED BY IVCOMP = 6 = 1 * 2 * 3 C IVCORR = 6 40050 IF ( IVCOMP - 6 ) 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 255 - TEST 006 **** C C TEST 006 IS SIMILAR TO THE PREVIOUS TEST EXCEPT THAT E1 IS TRUE C AND E2 IS FALSE. IF-BLOCK 1 AND ELSE-BLOCK 1 SHOULD BE EXECUTED. C C IVTNUM = 6 IF (ICZERO) 30060, 0060, 30060 0060 CONTINUE IVCOMP = 1 LVON01 = .TRUE. LVON02 = .FALSE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 IF ( LVON02 ) THEN IVCOMP = IVCOMP * 3 ELSE IVCOMP = IVCOMP * 5 END IF ELSE IVCOMP = IVCOMP * 7 END IF C C **** IVCOMP IS DETERMINED BY IVCOMP = 10 = 1 * 2 * 5 **** C IVCORR = 10 40060 IF ( IVCOMP - 10 ) 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 255 - TEST 007 **** C C TEST 007 AGAIN USES THE SAME STRUCTURE AS THE PREVIOUS TWO C TESTS. IN THIS TEST E1 IS FALSE AND E2 IS TRUE. ONLY ELSE-BLOCK C 2 SHOULD BE EXECUTED. C C IVTNUM = 7 IF (ICZERO) 30070, 0070, 30070 0070 CONTINUE IVCOMP = 1 LVON01 = .FALSE. LVON02 = .TRUE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 IF ( LVON02 ) THEN IVCOMP = IVCOMP * 3 ELSE IVCOMP = IVCOMP * 5 END IF ELSE IVCOMP = IVCOMP * 7 END IF C C **** IVCOMP IS DETERMINED BY IVCOMP = 7 = 1 * 7 **** C IVCORR = 7 40070 IF ( IVCOMP - 7 ) 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 C THE FOLLOWING TESTS USE A BLOCK IF STRUCTURE OF IF-LEVEL 3. C THE STRUCTURE AS SHOWN BELOW CONTAINS THE IF-THEN, ELSE IF-THEN, C AND ELSE STRUCTURES. C C IF ( E1 ) THEN C IF-BLOCK 1 C IF ( E2 ) THEN C IF-BLOCK 2 C IF ( E3 ) THEN C IF-BLOCK 3 C ELSE IF ( E4 ) THEN C ELSE IF-BLOCK 1 C ELSE IF ( E5 ) THEN C ELSE IF-BLOCK 2 C ELSE C ELSE-BLOCK 1 C END IF C MORE IF-BLOCK 2 C ELSE IF ( E6 ) THEN C ELSE IF-BLOCK 3 C ELSE C ELSE-BLOCK 2 C END IF C MORE IF-BLOCK 1 C ELSE IF ( E7 ) THEN C ELSE IF-BLOCK 4 C ELSE C ELSE-BLOCK 3 C END IF C C THE TRUE AND FALSE VALUES FOR THE VARIOUS LOGICAL EXPRESSIONS C USED IN THE TESTS TO FOLLOW ARE SHOWN BELOW - C C TEST NUMBER 8 9 10 11 12 13 14 15 C E1 T T T T T T F F C E2 T T T T F F F F C E3 T F F F F F F F C E4 T F F T F F F F C E5 T F T F F F F F C E6 T F F F T F F F C E7 T F F F F F T F C C C C **** FCVS PROGRAM 255 - TEST 008 **** C C TEST 008 SHOULD EXECUTE IF-BLOCKS 1, 2, AND 3. IT SHOULD ALSO C EXECUTE MORE IF-BLOCKS 2 AND 1. C C IVTNUM = 8 IF (ICZERO) 30080, 0080, 30080 0080 CONTINUE IVCOMP = 1 LVON01 = .TRUE. LVON02 = .TRUE. LVON03 = .TRUE. LVON04 = .TRUE. LVON05 = .TRUE. LVON06 = .TRUE. LVON07 = .TRUE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 IF ( LVON02 ) THEN IVCOMP = IVCOMP * 3 IF ( LVON03 ) THEN IVCOMP = IVCOMP * 5 ELSE IF ( LVON04 ) THEN IVCOMP = IVCOMP * 7 ELSE IF ( LVON05 ) THEN IVCOMP = IVCOMP * 11 ELSE IVCOMP = IVCOMP * 13 END IF IVCOMP = IVCOMP * 17 ELSE IF ( LVON06 ) THEN IVCOMP = IVCOMP * 19 ELSE IVCOMP = IVCOMP * 23 END IF IVCOMP = IVCOMP * 29 ELSE IF ( LVON07 ) THEN IVCOMP = IVCOMP * 31 ELSE GO TO 0082 END IF GO TO 0083 0082 IVCOMP = IVCOMP * 37 0083 CONTINUE C C **** IVCOMP IS DETERMINED BY IVCOMP = 14790 = 1 * 2 * 3 * 5 * C 17 * 29 **** C IVCORR = 14790 40080 IF ( IVCOMP - 14790 ) 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 255 - TEST 009 **** C C TEST 009 SHOULD EXECUTE IF-BLOCKS 1 AND 2. IT SHOULD ALSO C EXECUTE ELSE-BLOCK 1, PLUS MORE IF-BLOCKS 2 AND 1. C C IVTNUM = 9 IF (ICZERO) 30090, 0090, 30090 0090 CONTINUE IVCOMP = 1 LVON01 = .TRUE. LVON02 = .TRUE. LVON03 = .FALSE. LVON04 = .FALSE. LVON05 = .FALSE. LVON06 = .FALSE. LVON07 = .FALSE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 IF ( LVON02 ) THEN IVCOMP = IVCOMP * 3 IF ( LVON03 ) THEN IVCOMP = IVCOMP * 13 ELSE IF ( LVON04 ) THEN IVCOMP = IVCOMP * 17 ELSE IF ( LVON05 ) THEN IVCOMP = IVCOMP * 11 ELSE IVCOMP = IVCOMP * 5 END IF IVCOMP = IVCOMP * 7 ELSE IF ( LVON06 ) THEN IVCOMP = IVCOMP * 19 ELSE IVCOMP = IVCOMP * 23 END IF IVCOMP = IVCOMP * 29 ELSE IF ( LVON07 ) THEN IVCOMP = IVCOMP * 31 ELSE IF ( .TRUE. ) GO TO 0092 END IF GO TO 0093 0092 IVCOMP = IVCOMP * 37 0093 CONTINUE C C **** THE ORDER OF THE PRIME INTEGER MULTIPLIERS HAS BEEN C CHANGED TO KEEP THE IVCOMP RESULT SMALLER THAN 32767 **** C C C **** IVCOMP IS DETERMINED BY IVCOMP = 6090 = 1 * 2 * 3 * 5 * 7 C * 29 **** C IVCORR = 6090 40090 IF ( IVCOMP - 6090 ) 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 255 - TEST 010 **** C C TEST 010 SHOULD EXECUTE IF-BLOCKS 1 AND 2. IT SHOULD ALSO C EXECUTE ELSE IF-BLOCK 2, PLUS MORE IF-BLOCKS 2 AND 1. C C IVTNUM = 10 IF (ICZERO) 30100, 0100, 30100 0100 CONTINUE IVCOMP = 1 LVON01 = .TRUE. LVON02 = .TRUE. LVON03 = .FALSE. LVON04 = .FALSE. LVON05 = .TRUE. LVON06 = .FALSE. LVON07 = .FALSE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 IF ( LVON02 ) THEN IVCOMP = IVCOMP * 3 IF ( LVON03 ) THEN IVCOMP = IVCOMP * 5 ELSE IF ( LVON04 ) THEN IVCOMP = IVCOMP * 7 ELSE IF ( LVON05 ) THEN IVCOMP = IVCOMP * 11 ELSE IVCOMP = IVCOMP * 13 END IF IVCOMP = IVCOMP * 17 ELSE IF ( LVON06 ) THEN IVCOMP = IVCOMP * 19 ELSE IVCOMP = IVCOMP * 23 END IF IVCOMP = IVCOMP * 29 ELSE IF ( LVON07 ) THEN IVCOMP = IVCOMP * 31 ELSE ICON01 = 1 IF ( ICON01 ) 0103, 0102, 0103 END IF GO TO 0103 0102 IVCOMP = IVCOMP * 37 0103 CONTINUE C C **** IVCOMP IS DETERMINED BY IVCOMP = 32538 = 1 * 2 * 3 * 11 * C 17 * 29 **** C IVCORR = 32538 40100 IF ( IVCOMP - 32538 ) 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 255 - TEST 011 **** C C TEST 011 SHOULD EXECUTE IF-BLOCKS 1 AND 2. IT SHOULD ALSO C EXECUTE ELSE IF-BLOCK 1, PLUS MORE IF-BLOCKS 2 AND 1. C C IVTNUM = 11 IF (ICZERO) 30110, 0110, 30110 0110 CONTINUE IVCOMP = 1 LVON01 = .TRUE. LVON02 = .TRUE. LVON03 = .FALSE. LVON04 = .TRUE. LVON05 = .FALSE. LVON06 = .FALSE. LVON07 = .FALSE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 IF ( LVON02 ) THEN IVCOMP = IVCOMP * 3 IF ( LVON03 ) THEN IVCOMP = IVCOMP * 5 ELSE IF ( LVON04 ) THEN IVCOMP = IVCOMP * 7 ELSE IF ( LVON05 ) THEN IVCOMP = IVCOMP * 11 ELSE IVCOMP = IVCOMP * 13 END IF IVCOMP = IVCOMP * 17 ELSE IF ( LVON06 ) THEN IVCOMP = IVCOMP * 19 ELSE IVCOMP = IVCOMP * 23 END IF IVCOMP = IVCOMP * 29 ELSE IF ( LVON07 ) THEN IVCOMP = IVCOMP * 31 ELSE ASSIGN 0112 TO I GO TO I, ( 0113, 0112) END IF GO TO 0113 0112 IVCOMP = IVCOMP * 37 0113 CONTINUE C C **** IVCOMP IS DETERMINED BY IVCOMP = 20706 = 1 * 2 * 3 * 7 * C 17 * 29 **** C IVCORR = 20706 40110 IF ( IVCOMP - 20706 ) 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 255 - TEST 012 **** C C TEST 012 SHOULD EXECUTE IF-BLOCK 1, ELSE IF-BLOCK 3, AND MORE C IF-BLOCK 1. C C IVTNUM = 12 IF (ICZERO) 30120, 0120, 30120 0120 CONTINUE IVCOMP = 1 LVON01 = .TRUE. LVON02 = .FALSE. LVON03 = .FALSE. LVON04 = .FALSE. LVON05 = .FALSE. LVON06 = .TRUE. LVON07 = .FALSE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 IF ( LVON02 ) THEN IVCOMP = IVCOMP * 3 IF ( LVON03 ) THEN IVCOMP = IVCOMP * 5 ELSE IF ( LVON04 ) THEN IVCOMP = IVCOMP * 7 ELSE IF ( LVON05 ) THEN IVCOMP = IVCOMP * 11 ELSE IVCOMP = IVCOMP * 13 END IF IVCOMP = IVCOMP * 17 ELSE IF ( LVON06 ) THEN IVCOMP = IVCOMP * 19 ELSE IVCOMP = IVCOMP * 23 END IF IVCOMP = IVCOMP * 29 ELSE IF ( LVON07 ) THEN IVCOMP = IVCOMP * 31 ELSE I = 2 GO TO ( 0123, 0122 ), I END IF GO TO 0123 0122 IVCOMP = IVCOMP * 37 0123 CONTINUE C C **** IVCOMP IS DETERMINED BY IVCOMP = 1102 = 1 * 2 * 19 * 29 C IVCORR = 1102 40120 IF ( IVCOMP - 1102 ) 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 255 - TEST 013 **** C C TEST 013 SHOULD EXECUTE IF-BLOCK 1, ELSE-BLOCK 2, AND MORE C IF-BLOCK 1. C C IVTNUM = 13 IF (ICZERO) 30130, 0130, 30130 0130 CONTINUE IVCOMP = 1 LVON01 = .TRUE. LVON02 = .FALSE. LVON03 = .FALSE. LVON04 = .FALSE. LVON05 = .FALSE. LVON06 = .FALSE. LVON07 = .FALSE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 IF ( LVON02 ) THEN IVCOMP = IVCOMP * 3 IF ( LVON03 ) THEN IVCOMP = IVCOMP * 5 ELSE IF ( LVON04 ) THEN IVCOMP = IVCOMP * 7 ELSE IF ( LVON05 ) THEN IVCOMP = IVCOMP * 11 ELSE IVCOMP = IVCOMP * 13 END IF IVCOMP = IVCOMP * 17 ELSE IF ( LVON06 ) THEN IVCOMP = IVCOMP * 19 ELSE IVCOMP = IVCOMP * 23 END IF IVCOMP = IVCOMP * 29 ELSE IF ( LVON07 ) THEN IVCOMP = IVCOMP * 31 ELSE GO TO 0132 END IF GO TO 0133 0132 IVCOMP = IVCOMP * 37 0133 CONTINUE C C **** IVCOMP IS DETERMINED BY IVCOMP = 1334 = 1 * 2 * 23 * 29 C IVCORR = 1334 40130 IF ( IVCOMP - 1334 ) 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 **** FCVS PROGRAM 255 - TEST 014 **** C C TEST 014 SHOULD ONLY EXECUTE ELSE IF-BLOCK 4. C C IVTNUM = 14 IF (ICZERO) 30140, 0140, 30140 0140 CONTINUE IVCOMP = 1 LVON01 = .FALSE. LVON02 = .FALSE. LVON03 = .FALSE. LVON04 = .FALSE. LVON05 = .FALSE. LVON06 = .FALSE. LVON07 = .TRUE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 IF ( LVON02 ) THEN IVCOMP = IVCOMP * 3 IF ( LVON03 ) THEN IVCOMP = IVCOMP * 5 ELSE IF ( LVON04 ) THEN IVCOMP = IVCOMP * 7 ELSE IF ( LVON05 ) THEN IVCOMP = IVCOMP * 11 ELSE IVCOMP = IVCOMP * 13 END IF IVCOMP = IVCOMP * 17 ELSE IF ( LVON06 ) THEN IVCOMP = IVCOMP * 19 ELSE IVCOMP = IVCOMP * 23 END IF IVCOMP = IVCOMP * 29 ELSE IF ( LVON07 ) THEN IVCOMP = IVCOMP * 31 ELSE IF ( .NOT. .FALSE. ) GO TO 0142 END IF GO TO 0143 0142 IVCOMP = IVCOMP * 37 0143 CONTINUE C C **** IVCOMP IS DETERMINED BY IVCOMP = 31 = 1 * 31 **** C IVCORR = 31 40140 IF ( IVCOMP - 31 ) 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 255 - TEST 015 **** C C TEST 015 SHOULD ONLY EXECUTE THE LOGIC IN ELSE-BLOCK 3. THIS C LOGIC CONSISTS OF AN ARITHMETIC IF STATEMENT WHICH SHOULD TAKE C THE EXPRESSION EQUAL TO ZERO BRANCH TO STATEMENT 0152. C C IVTNUM = 15 IF (ICZERO) 30150, 0150, 30150 0150 CONTINUE IVCOMP = 1 LVON01 = .FALSE. LVON02 = .FALSE. LVON03 = .FALSE. LVON04 = .FALSE. LVON05 = .FALSE. LVON06 = .FALSE. LVON07 = .FALSE. IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 IF ( LVON02 ) THEN IVCOMP = IVCOMP * 3 IF ( LVON03 ) THEN IVCOMP = IVCOMP * 5 ELSE IF ( LVON04 ) THEN IVCOMP = IVCOMP * 7 ELSE IF ( LVON05 ) THEN IVCOMP = IVCOMP * 11 ELSE IVCOMP = IVCOMP * 13 END IF IVCOMP = IVCOMP * 17 ELSE IF ( LVON06 ) THEN IVCOMP = IVCOMP * 19 ELSE IVCOMP = IVCOMP * 23 END IF IVCOMP = IVCOMP * 29 ELSE IF ( LVON07 ) THEN IVCOMP = IVCOMP * 31 ELSE ICON01 = 1 IF ( ICON01 - 1 ) 0153, 0152, 0153 END IF GO TO 0153 0152 IVCOMP = IVCOMP * 37 0153 CONTINUE C C **** IVCOMP IS DETERMINED BY IVCOMP = 37 = 1 * 37 **** C IVCORR = 37 40150 IF ( IVCOMP - 37 ) 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 255 - TEST 016 **** C C TEST 016 IS A TEST OF THE END IF STATEMENT. SECTION 11.9 C PERMITS TRANSFER OF CONTROL FROM ANYWHERE TO AN END IF STATEMENT. C ALSO ACCORDING TO SECTION 11.9 - EXECUTION OF AN END IF STATEMENT C HAS NO EFFECT. C C IVTNUM = 16 IF (ICZERO) 30160, 0160, 30160 0160 CONTINUE IVCOMP = 1 LVON01 = .TRUE. IF ( ICZERO ) 0163, 0162, 0163 0162 GO TO 0164 0163 IF ( LVON01 ) THEN IVCOMP = IVCOMP * 2 ELSE IVCOMP = IVCOMP * 3 0164 END IF C C **** IVCOMP SHOULD REMAIN SET TO ONE (1). **** C IVCORR = 1 40160 IF ( IVCOMP - 1 ) 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 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,5HFM255) 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM255) 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