PROGRAM FM302
C
C
C        THIS ROUTINE TESTS THE SUBSET LEVEL FEATURES OF THE COMMON
C     SPECIFICATION STATEMENT.  INTEGER, REAL AND LOGICAL VARIABLES AND
C     ARRAYS ARE PASSED BACK-AND-FORTH BETWEEN THE MAIN PROGRAM,EXTERNAL
C     FUNCTIONS AND SUBROUTINES.  BOTH NAMED AND UNNAMED (BLANK) COMMON
C     ARE TESTED.  SPECIFIC TESTS ARE INCLUDED FOR RENAMING ENTITIES IN
C     COMMON BETWEEN PROGRAM UNITS, THE PASSING OF DATA THROUGH COMMON
C     BY EQUIVALENCE ASSOCIATION, AND THE SPECIFYING OF BLANK COMMON OF
C     DIFFERENT LENGTHS IN DIFFERENT PROGRAM UNITS.  THE SUBSET LEVEL
C     FEATURES OF THE COMMON STATEMENT ARE ALSO TESTED IN FM022 THROUGH
C     FM025, FM050 AND FM056.
C
C     REFERENCES.
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C           X3.9-1978
C
C        SECTION 8.2,    EQUIVALENCE STATEMENT
C        SECTION 8.3,    COMMON STATEMENT
C        SECTION 15.5,   EXTERNAL FUNCTIONS
C        SECTION 15.6,   SUBROUTINES
C        SECTION 15.9.4, COMMON BLOCKS
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          *** SPECIFICATION STATEMENT FOR TEST 001 ***
C
      COMMON IVCN01
C
C          *** SPECIFICATION STATEMENT FOR TEST 002 ***
C
      COMMON //IVCN02,LVCN01
C
C          *** SPECIFICATION STATEMENT FOR TEST 003 ***
C
      COMMON RVCN01//IVCN03
C
C          *** SPECIFICATION STATEMENT FOR TEST 004 ***
C
      COMMON IVCN04, IVCN05,  // IACN11(4)
C
C          *** SPECIFICATION STATEMENT FOR TEST 005 ***
C
      COMMON /BLK1/ IVCNA1
C
C          *** SPECIFICATION STATEMENT FOR TEST 006 ***
C
      COMMON /BLK2/IVCNB1,RVCNB1, /BLK2/IVCNB2
C
C          *** SPECIFICATION STATEMENT FOR TEST 007 ***
C
      DIMENSION RACN11(10)
      COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3)
C
C          *** SPECIFICATION STATEMENT FOR TEST 008 ***
C
      COMMON /BLK5/IVCND1, IVCND2
C
C          *** SPECIFICATION STATEMENT FOR TEST 009 ***
C
      COMMON IVCN06/BLK5/RVCND1,LVCND1//IVCN07,IVCN08/BLK6/RVCNE1
C
C          *** SPECIFICATION STATEMENT FOR TEST 010 ***
C
      DIMENSION IACN1F(3)
      COMMON /BLK7/IVCNF1,IVCNF2,IVCNF3,IACN1F
C
C          *** SPECIFICATION STATEMENT FOR TEST 011 ***
C
      EQUIVALENCE (IVCEH1,IVCEH2)
      COMMON /BLK8/IVCEH1
C
C          *** SPECIFICATION STATEMENT FOR TEST 012
      EQUIVALENCE (IVCE09,IVCE10)
      COMMON IVCE09
C
C          *** SPECIFICATION STATEMENT FOR TEST 013
C
      EQUIVALENCE (IVCEI1,IACE1I)
      DIMENSION IACE1I(3)
      COMMON /BLK9/IVCEI1
C
C          *** SPECIFICATION STATEMENT FOR TEST 014 ***
C
      COMMON IVCN12
C
C          *** SPECIFICATION STATEMENT FOR TEST 015 ***
C
      COMMON /BLK10/IVCNJ1
C
C          *** SPECIFICATION STATEMENT FOR TEST 016 ***
C
      COMMON /BLKCHR/CVTN01,CVTN02,CATN11
      CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5
      INTEGER FF304
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          THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA
C     ENTITIES BEING PASSED THROUGH COMMON TO SUBROUTINE FS303.  ONLY
C     ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM.  THE
C     CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON ARE
C     THEN CHECKED IN THIS PROGRAM.
C
C
      IVCN01 = 3
      IVCN02 = 2
      LVCN01 = .FALSE.
      IVCNA1 = 25
      IVCNB1 = 3
      RVCNB1 = 4.0
      IVCNB2 = 5
      LVCNC1 = .TRUE.
      IVCNC1 = 13
      RACN11(1) = 1.
      RACN11(10) = 10.0
      IACN21(1,1) = 11
      IACN21(2,3) = 23
      IVCNF1 = 41
      IVCNF3 = 43
      IACN1F(1) = 141
      IACN1F(2) = 142
      IVCEH1 = 1
      IVCEH2 = 5
      CVTN01 = 'AB'
      CVTN02 = 'CDE'
      CATN11(1) = 'FGHIJ'
      CATN11(2) = 'KLMNO'
      CATN11(3) = 'PQRST'
      CALL FS303
C
C          THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA
C     ENTITIES BEING PASSED THROUGH COMMON TO EXTERNAL FUNCTION FF304.
C     ONLY ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM.
C     THE CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON
C     ARE THEN CHECKED IN THIS PROGRAM.
C
      RVCN01 = 6.4
      IVCN03 = 11
      IVCN03 = IVCN03*2
      IVCN04 = 16
      IVCN05 = 16
      IACN11(1) = 1
      IACN11(2) = 2
      IACN11(3) = 3
      IACN11(4) = 4
      IVCND1 = +33
      IVCND2 = 10
      IVCN06 = 6
      IVCN07 = 7
      IVCN08 = 8
      RVCND1 = 1.3
      LVCND1 = .FALSE.
      RVCNE1 = +3.5
      IVCE09 = 9
      IVCE10 = 10
      IVCEI1 = 5
      IACE1I(1) = 10
      IACE1I(2) = 15
      IACE1I(3) = 20
      IVCNJ1 = 1
      IVON99 = FF304 ( )
C
C          TESTS 001 THROUGH 009 ARE DESIGNED TO TEST VARIOUS
C     SYNTACTICAL CONSTRUCTS OF THE COMMON STATEMENT USING NAMED AND
C     UNNAMED (BLANK) COMMON IN THE MAIN PROGRAM, A SUBROUTINE AND AN
C     EXTERNAL FUNCTION.  DATA ENTITIES CONSIST OF INTEGER, REAL AND
C     LOGICAL VARIABLES AND INTEGER AND REAL ARRAYS.
C
C     ****  FCVS PROGRAM 302  -  TEST 001  ****
C
C          TESTS 001 AND 002 TEST THE USE OF UNNAMED COMMON IN A MAIN
C     PROGRAM AND A SUBROUTINE.
C
      IVTNUM =   1
      IF (ICZERO) 30010, 0010, 30010
 0010 CONTINUE
      IVCOMP = 0
      IVCOMP = IVCN01
      IVCORR = 4
40010 IF (IVCOMP - 4) 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 302  -  TEST 002  ****
C
C
      IVTNUM =   2
      IF (ICZERO) 30020, 0020, 30020
 0020 CONTINUE
      IVCOMP = 1
      IF (IVCN02 .EQ. 7) IVCOMP = IVCOMP * 2
      IF (LVCN01) IVCOMP = IVCOMP * 3
      IVCORR = 6
C          6 = 2 * 3
40020 IF (IVCOMP - 6) 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 302  -  TEST 003  ****
C
C          TESTS 003 AND 004 TEST THE USE OF UNNAMED COMMON IN A MAIN
C     PROGRAM AND AN EXTERNAL FUNCTION.
C
      IVTNUM =   3
      IF (ICZERO) 30030, 0030, 30030
 0030 CONTINUE
      IVCOMP = 1
      IF (RVCN01 .GE. 4.1995 .AND. RVCN01 .LE. 4.2005) IVCOMP=IVCOMP*2
      IF (IVCN03 .EQ.  23) IVCOMP = IVCOMP * 3
      IVCORR = 6
C          6 = 2 * 3
40030 IF (IVCOMP - 6) 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 302  -  TEST 004  ****
C
C
      IVTNUM =   4
      IF (ICZERO) 30040, 0040, 30040
 0040 CONTINUE
      IVCOMP = 1
      IF (IVCN04 .EQ. 8) IVCOMP = IVCOMP * 2
      IF (IVCN05 .EQ. 16) IVCOMP = IVCOMP * 3
      IF (IACN11(1) .EQ. 5) IVCOMP = IVCOMP * 5
      IF (IACN11(2) .EQ. 5) IVCOMP = IVCOMP * 7
      IF (IACN11(3) .EQ. 5) IVCOMP = IVCOMP * 11
      IF (IACN11(4) .EQ. 5) IVCOMP = IVCOMP * 13
      IVCORR = 30030
C     30030  = 2 * 3 * 5 * 7 * 11 * 13
40040 IF (IVCOMP - 30030) 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 302  -  TEST 005  ****
C
C          TESTS 005 THROUGH 007 TEST THE USE OF NAMED COMMON BLOCKS
C     IN A MAIN PROGRAM AND A SUBROUTINE.
C
      IVTNUM =   5
      IF (ICZERO) 30050, 0050, 30050
 0050 CONTINUE
      IVCOMP = 0
      IVCOMP = IVCNA1
      IVCORR = 5
40050 IF (IVCOMP - 5) 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 302  -  TEST 006  ****
C
C
      IVTNUM =   6
      IF (ICZERO) 30060, 0060, 30060
 0060 CONTINUE
      IVCOMP = 1
      IF (IVCNB1 .EQ. 8) IVCOMP = IVCOMP * 2
      IF (RVCNB1 .GE. 3.4995 .AND. RVCNB1 .LE. 3.5005) IVCOMP=IVCOMP*3
      IF (IVCNB2 .EQ. 5) IVCOMP = IVCOMP * 5
      IVCORR = 30
C         30 = 2 * 3 * 5
40060 IF (IVCOMP - 30) 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 302  -  TEST 007  ****
C
C
      IVTNUM =   7
      IF (ICZERO) 30070, 0070, 30070
 0070 CONTINUE
      IVCOMP = 1
      IF (.NOT. LVCNC1) IVCOMP = IVCOMP * 2
      IF (IVCNC1 .EQ. 12) IVCOMP = IVCOMP * 3
      IF (RACN11(1).GE.110.95 .AND. RACN11(1).LE.111.05) IVCOMP=IVCOMP*5
      IF (RACN11(10).GE.109.95.AND.RACN11(10).LE.110.05)IVCOMP=IVCOMP*7
      IF (IACN21(1,1) .EQ. 12) IVCOMP = IVCOMP * 11
      IF (IACN21 (2,3) .EQ. 24) IVCOMP = IVCOMP * 13
      IVCORR = 30030
C     30030  = 2* 3 * 5 * 7 * 11 * 13
40070 IF (IVCOMP - 30030) 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 302  -  TEST 008  ****
C
C          TESTS 008 AND 009 TEST THE USE OF NAMED COMMON BLOCKS IN A
C     MAIN PROGRAM AND AN EXTERNAL FUNCTION.
C
      IVTNUM =   8
      IF (ICZERO) 30080, 0080, 30080
 0080 CONTINUE
      IVCOMP = 1
      IF (IVCND1 .EQ. 34) IVCOMP = IVCOMP * 2
      IF (IVCND2 .EQ. 11) IVCOMP = IVCOMP * 3
      IVCORR = 6
C          6 = 2 * 3
40080 IF (IVCOMP - 6) 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 302  -  TEST 009  ****
C
C
      IVTNUM =   9
      IF (ICZERO) 30090, 0090, 30090
 0090 CONTINUE
      IVCOMP = 1
      IF (IVCN06 .EQ. 7) IVCOMP = IVCOMP * 2
      IF (RVCND1 .GE. 4.4995 .AND. RVCND1 .LE. 4.5005) IVCOMP = IVCOMP*3
      IF (LVCND1) IVCOMP = IVCOMP * 5
      IF (IVCN07 .EQ. -7) IVCOMP = IVCOMP * 7
      IF (IVCN08 .EQ. -3) IVCOMP = IVCOMP * 11
      IF (RVCNE1.GE.-6.7005.AND.RVCNE1.LE.-6.6995) IVCOMP=IVCOMP*13
      IVCORR = 30030
C     30030  = 2 * 3 * 5 * 7 * 11 * 13
40090 IF (IVCOMP - 30030) 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 302  -  TEST 010  ****
C
C          TEST 010 IS DESIGNED TO TEST THE ABILITY TO RENAME ENTITIES
C     IN NAMED COMMON BETWEEN A MAIN PROGRAM AND A SUBROUTINE.
C
      IVTNUM =  10
      IF (ICZERO) 30100, 0100, 30100
 0100 CONTINUE
      IVCOMP = 1
      IF (IVCNF1 .EQ. 42) IVCOMP = IVCOMP * 2
      IF (IVCNF2 .EQ. 43) IVCOMP = IVCOMP * 3
      IF (IVCNF3 .EQ. 44) IVCOMP = IVCOMP * 5
      IF (IACN1F(1) .EQ. 142) IVCOMP = IVCOMP * 7
      IF (IACN1F(2) .EQ. 143) IVCOMP = IVCOMP * 11
      IF (IACN1F(3) .EQ. 144) IVCOMP = IVCOMP * 13
      IVCORR = 30030
C     30030 = 2 * 3 * 5 * 7 * 11 * 13
40100 IF (IVCOMP - 30030) 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 302  -  TEST 011  ****
C
C          TEST 011 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE  IN
C     NAMED COMMON BY EQUIVALENCE ASSOCIATION.
C
      IVTNUM =  11
      IF (ICZERO) 30110, 0110, 30110
 0110 CONTINUE
      IVCOMP = 0
      IVCOMP = IVCEH2
      IVCORR = 6
40110 IF (IVCOMP - 6) 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 302  -  TEST 012  ****
C
C          TEST 012 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE IN
C     UNNAMED COMMON BY EQUIVALENCE ASSOCIATION.
C
      IVTNUM =  12
      IF (ICZERO) 30120, 0120, 30120
 0120 CONTINUE
      IVCOMP = 1
      IF (IVCE09 .EQ. 100) IVCOMP = IVCOMP * 2
      IF (IVCE10 .EQ. 100) IVCOMP = IVCOMP * 3
      IVCORR = 6
C     6 = 2 * 3
40120 IF (IVCOMP - 6) 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 302  -  TEST 013  ****
C
C          TEST 013 IS DESIGNED TO TEST THE EXTENSION OF NAMED COMMON
C     BLOCK STORAGE BY EQUIVALENCE ASSOCIATION OF A VARIABLE AND AN
C     ARRAY.
C
      IVTNUM =  13
      IF (ICZERO) 30130, 0130, 30130
 0130 CONTINUE
      IVCOMP = 1
      IF (IVCEI1 .EQ. 11) IVCOMP = IVCOMP * 2
      IF (IACE1I(1) .EQ. 11) IVCOMP = IVCOMP * 3
      IF (IACE1I(2) .EQ. 16) IVCOMP = IVCOMP * 5
      IF (IACE1I(3) .EQ. 21) IVCOMP = IVCOMP * 7
      IVCORR = 210
C     210 = 2 * 3 * 5 * 7
40130 IF (IVCOMP - 210) 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 302  -  TEST 014  ****
C
C          TEST 014 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA
C     THROUGH UNNAMED COMMON FROM EXTERNAL FUNCTIONS WHICH HAVE MORE
C     ENTITIES IN UNNAMED COMMON THAN THE MAIN PROGRAM.
C
      IVTNUM =  14
      IF (ICZERO) 30140, 0140, 30140
 0140 CONTINUE
      IVCOMP = 0
      IVCOMP = IVCN12
      IVCORR = 11
40140 IF (IVCOMP - 11) 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 302  -  TEST 015  ****
C
C          TEST 015 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA
C     THROUGH NAMED COMMON BETWEEN EXTERNAL FUNCTIONS WHERE THE NAMED
C     COMMON BLOCK IS NOT SPECIFIED IN THE MAIN PROGRAM.
C
      IVTNUM =  15
      IF (ICZERO) 30150, 0150, 30150
 0150 CONTINUE
      IVCOMP = 0
      IVCOMP = IVCNJ1
      IVCORR = 5
40150 IF (IVCOMP - 5) 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 302  -  TEST 016  ****
C
C          TEST 016 IS DESIGNED TO TEST THE PASSING OF CHARACTER DATA
C     IN NAMED COMMON BETWEEN THE MAIN PROGRAM AND A SUBROUTINE.
C
      IVTNUM =  16
      IF (ICZERO) 30160, 0160, 30160
 0160 CONTINUE
      IVCOMP = 1
      IF (CVTN01 .EQ. 'YZ') IVCOMP = IVCOMP * 2
      IF (CVTN02 .EQ. 'UVW') IVCOMP = IVCOMP * 3
      IF (CATN11(1) .EQ. 'VWXYZ') IVCOMP = IVCOMP * 5
      IF (CATN11(2) .EQ. 'KLMNO') IVCOMP = IVCOMP * 7
      IF (CATN11(3) .EQ. 'ABCDE') IVCOMP = IVCOMP * 11
      IVCORR = 2310
C     2310 = 2 * 3 * 5 * 7 * 11
40160 IF (IVCOMP - 2310) 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,5HFM302)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM302)
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
      SUBROUTINE FS303
C
C        FS303 IS A SUBROUTINE WHICH IS CALLED ONCE FROM PROGRAM FM302.
C     IT IS USED TO MODIFY VARIABLES AND ARRAY PASSED THROUGH NAMED AND
C     UNNAMED COMMON FROM FM302.  AFTER THE DATA ENTITIES ARE MODIFIED
C     CONTROL IS RETURNED TO FM302 WHERE EACH ENTITY IS TESTED.
C
      IMPLICIT LOGICAL (L)
      DIMENSION RACN11(10)
      COMMON IVCN01
      COMMON //IVCN02, LVCN01
      COMMON RVCN01//IVCN03
      COMMON IVCN04,IVCN05, //IACN11(4)
      COMMON /BLK1/IVCNA1
      COMMON /BLK2/IVCNB1,RVCNB1,/BLK2/IVCNB2
      COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3)
      COMMON /BLK7/IACN1G(5),IVCNG1
      COMMON /BLK8/IVCNH1
      COMMON /BLKCHR/CVTN01,CVTN02,CATN11
      CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5
C     TEST 001
           IVCN01 = IVCN01 + 1
C     TEST 002
           IVCN02 = IVCN02 + 5
           LVCN01 = .NOT. LVCN01
C     TEST 005
           IVCNA1 = IVCNA1 / 5
C     TEST 006
           IVCNB1 = IVCNB1 + IVCNB2
           RVCNB1 = 3.5
C     TEST 007
           LVCNC1 = .FALSE.
           IVCNC1 = IVCNC1 - 1
           RACN11(1) = 111.
           RACN11(10) = 110.
           IACN21(1,1) = IACN21(1,1) + 1
           IACN21(2,3) = IACN21(2,3) + 1
C     TEST 010
           IACN1G(1) = IACN1G(1) + 1
           IACN1G(2) = 43
           IACN1G(3) = IACN1G(3) + 1
           IACN1G(4) = IACN1G(4) + 1
           IACN1G(5) = IACN1G(5) + 1
           IVCNG1 = 144
C     TEST 011
           IVCNH1 = IVCNH1 + 1
C     TEST 017
           CVTN01 = 'YZ'
           CVTN02 = 'UVW'
           CATN11(1) = 'VWXYZ'
           CATN11(3) = 'ABCDE'
      RETURN
      END
      INTEGER FUNCTION FF304 ()
C
C          FF304 IS AN EXTERNAL FUNCTION WHICH IS REFERENCED ONCE FROM
C     PROGRAM FM302.  IT IS USED TO MODIFY VARIABLES AND ARRAYS PASSED
C     THROUGH NAMED AND UNNAMED COMMON FROM FM302.  AFTER THE DATA
C     ENTITIES ARE MODIFIED CONTROL IS RETURNED TO FM302 WHERE EACH
C     ENTITY IS TESTED.  A FUNCTION VALUE OF 999 IS RETURNED BUT IT IS
C     NOT SIGNIFICANT NOR IS IT TESTED BY FM302.
C
      IMPLICIT LOGICAL (L)
      DIMENSION IACN11(4)
      COMMON IVCN01
      COMMON IVCN02, LVCN01
      COMMON RVCN01, IVCN03
      COMMON IVCN04,IVCN05,IACN11
      COMMON /BLK5/IVCND1,IVCND2
      COMMON IVCN06
      COMMON /BLK5/RVCND1,LVCND1
      COMMON IVCN07, IVCN08
      COMMON /BLK6/RVCNE1
      COMMON IVCN10
      COMMON /BLK9/IVCNI1, IVCNI2, IVCNI3
      COMMON IVCN12, IVCN13
      COMMON /BLK10/IVCNJ1
      COMMON /BLK11/IVCNK1
      INTEGER FF305
C     TEST 003
           RVCN01 = 4.2
           IVCN03 = IVCN03 + 1
C     TEST 004
           IVCN04 = 32
           IVCN04 = IVCN04 / 4
           IVCN05 = IVCN05
           IACN11(1) = IACN11(1) + 4
           IACN11(2) = IACN11(2) + 3
           IACN11(3) = IACN11(3) + 2
           IACN11(4) = IACN11(4) + 1
C     TEST 008
           IVCND1 = IVCND1 + 1
           IVCND2 = IVCND2 + 1
C     TEST 009
           IVCN06 = IVCN06 + 1
           RVCND1 = 4.5
           LVCND1 = .TRUE.
           IVCN07 = -IVCN07
           IVCN08 = -3
           RVCNE1 = -6.7
C     TEST 012
           IVCN10 = IVCN10 * IVCN10
C     TEST 013
           IVCNI1 = IVCNI1 + 1
           IVCNI2 = IVCNI2 + 1
           IVCNI3 = IVCNI3 + 1
C     TEST 014
           IVCN13 = 5
C     TEST 015
           IVCNK1 = 3
C
C     FOR TESTS 014 AND 015 EXTERNAL FUNCTION FF305 IS REFERENCED
C
           IVON99 = FF305 ()
C     TEST 014
           IVCN12 = IVCN13
C     TEST 015
           IVCNJ1 = IVCNK1
      FF304 = 999
      RETURN
      END
      INTEGER FUNCTION FF305 ()
C
C          FF305 IS AN EXTERNAL FUNCTION WHICH IS USED IN TEST 014 AND
C     015 OF PROGRAM FM302. THIS SUBPROGRAM IS REFERENCED FROM EXTERNAL
C     FUNCTION FF304.
C
      COMMON IACN11(15)
      COMMON IVCN12, IVCN13, IVCN14
      COMMON /BLK10/IVCNJ1, /BLK11/IVCNK1
C     TEST 014
           IVCN14 = 11
           IVCN13 = IVCN14
C     TEST 015
           IVCNK1 = 5
      FF305 = 999
      RETURN
      END