PROGRAM FM306
C
C
C          THIS ROUTINE TESTS THE USE OF THE SUBSET LEVEL FEATURES OF
C     THE IMPLICIT SPECIFICATION STATEMENT.  THE DEFAULT IMPLIED INTEGER
C     AND REAL TYPING IS EITHER CONFIRMED OR OVERRIDDEN TO SPECIFY
C     INTEGER, REAL AND LOGICAL TYPING.  ALL 26 ALPHABETIC LETTERS ARE
C     USED TO INDICATE THE IMPLICIT TYPING.  VARIABLE AND ARRAY
C     ENTITIES ARE USED TO TEST THE ACTUAL TYPING.  THE SUBSET LEVEL
C     FEATURES OF THE IMPLICIT STATEMENT ARE ALSO TESTED IN ROUTINES
C     FM201 AND FM251.
C
C     REFERENCES.
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C           X3.9-1978
C
C        SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS.
C        SECTION 8.5,   IMPLICIT STATEMENT
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
      IMPLICIT INTEGER (A)
      IMPLICIT LOGICAL (B)
      IMPLICIT INTEGER (D,E,F)
      IMPLICIT REAL (G-H)
      IMPLICIT INTEGER (I)
      IMPLICIT REAL (J)
      IMPLICIT INTEGER (K,O-Q)
      IMPLICIT REAL (M), REAL (N)
      IMPLICIT REAL (R)
      IMPLICIT REAL (S), INTEGER (T-V)
      IMPLICIT INTEGER (W), REAL (X), LOGICAL (Y), INTEGER (Z)
      DIMENSION AAIN11(5)
      DIMENSION HAIN11(5)
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     ****  FCVS PROGRAM 306  -  TEST 001  ****
C
C     TEST 001 IS DESIGNED TO CONFIRM IMPLICIT INTEGER TYPING.
C
      IVTNUM =   1
      IF (ICZERO) 30010, 0010, 30010
 0010 CONTINUE
      RVCOMP = 10.0
      IVIN01 = 4
      RVCOMP = IVIN01 / 5
      RVCORR = 0.0
40010 IF (RVCOMP) 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,80012) IVTNUM, RVCOMP, RVCORR
 0021 CONTINUE
C
C     ****  FCVS PROGRAM 306  -  TEST 002  ****
C
C     TEST 002 IS DESIGNED TO CONFIRM IMPLICIT REAL TYPING.
C
      IVTNUM =   2
      IF (ICZERO) 30020, 0020, 30020
 0020 CONTINUE
      RVCOMP = 10.0
      RVIN01 = 4
      RVCOMP = RVIN01/5
      RVCORR = .8
40020 IF (RVCOMP - .79995) 20020, 10020, 40021
40021 IF (RVCOMP - .80005) 10020, 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,80012) IVTNUM, RVCOMP, RVCORR
 0031 CONTINUE
C
C     ****  FCVS PROGRAM 306  -  TEST 003  ****
C
C     TEST 003 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF
C     INTEGER WITH IMPLICIT TYPING OF REAL.
C
      IVTNUM =   3
      IF (ICZERO) 30030, 0030, 30030
 0030 CONTINUE
      RVCOMP = 10.0
      JVIN01 = 4
      RVCOMP = JVIN01/5
      RVCORR = .8
40030 IF (RVCOMP - .79995) 20030, 10030, 40031
40031 IF (RVCOMP - .80005) 10030, 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,80012) IVTNUM, RVCOMP, RVCORR
 0041 CONTINUE
C
C     ****  FCVS PROGRAM 306  -  TEST 004  ****
C
C     TEST 004 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF
C     INTEGER WITH IMPLICIT TYPING OF LOGICAL.
C
      IVTNUM =   4
      IF (ICZERO) 30040, 0040, 30040
 0040 CONTINUE
      LVIN01 = .TRUE.
      IVCORR = 1
      IVCOMP = 0
      IF (LVIN01) IVCOMP = 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 306  -  TEST 005  ****
C
C     TEST 005 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF
C     REAL WITH IMPLICIT TYPING OF INTEGER.
C
      IVTNUM =   5
      IF (ICZERO) 30050, 0050, 30050
 0050 CONTINUE
      RVCOMP = 10.0
      AAIN11(2) = 4
      RVCOMP = AAIN11(2)/5
      RVCORR = 0.0
40050 IF (RVCOMP) 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,80012) IVTNUM, RVCOMP, RVCORR
 0061 CONTINUE
C
C     ****  FCVS PROGRAM 306  -  TEST 006  ****
C
C     TEST 006 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF REAL
C     WITH IMPLICIT TYPING OF LOGICAL.
C
      IVTNUM =   6
      IF (ICZERO) 30060, 0060, 30060
 0060 CONTINUE
      BVIN01 = .TRUE.
      IVCORR = 1
      IVCOMP = 0
      IF (BVIN01) IVCOMP = 1
40060 IF (IVCOMP - 1) 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     TESTS 007 THROUGH 012 ARE DESIGNED TO TEST VARIOUS SYNTACTICAL
C     CONSTRUCTS OF THE IMPLICIT STATEMENT.
C
C
C     ****  FCVS PROGRAM 306  -  TEST 007  ****
C
C     TEST 007 TESTS THE SPECIFYING OF MORE THAN ONE ALPHABETIC
C     CHARACTER IN AN IMPLICIT STATEMENT.
C
      IVTNUM =   7
      IF (ICZERO) 30070, 0070, 30070
 0070 CONTINUE
      DVIN01 = 4
      EVIN01 = 4
      FVIN01 = 4
      RVCMP1 = DVIN01/5
      RVCMP2 = EVIN01/5
      RVCMP3 = FVIN01/5
      IVCOMP = 1
      IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2
      IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3
      IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5
      IVCORR = 30
C     30 = 2 * 3 * 5
40070 IF (IVCOMP -    30) 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 306  -  TEST 008  ****
C
C     TEST 008 TESTS THE SPECIFYING A RANGE OF SINGLE LETTERS IN
C     ALPHABETIC ORDER IN AN IMPLICIT STATEMENT.
C
      IVTNUM =   8
      IF (ICZERO) 30080, 0080, 30080
 0080 CONTINUE
      GVIN01 = 4
      HAIN11(4) = 4
      RVCMP1 = GVIN01/5
      RVCMP2 = HAIN11(4)/5
      IVCOMP = 1
      IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2
      IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) 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 306  -  TEST 009  ****
C
C     TEST 009 TESTS THE SPECIFYING A SINGLE LETTER AND A RANGE OF
C     SINGLE LETTERS IN ALPHABETIC ORDER IN AN IMPLICIT STATEMENT.
C
      IVTNUM =   9
      IF (ICZERO) 30090, 0090, 30090
 0090 CONTINUE
      KVIN01 = 4
      OVIN01 = 4
      PVIN01 = 4
      QVIN01 = 4
      RVCMP1 = KVIN01/5
      RVCMP2 = OVIN01/5
      RVCMP3 = PVIN01/5
      RVCMP4 = QVIN01/5
      IVCOMP = 1
      IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2
      IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3
      IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5
      IF (RVCMP4 .EQ. 0.0) IVCOMP = IVCOMP * 7
      IVCORR = 210
C     210 = 2 * 3 * 5 * 7
40090 IF (IVCOMP - 210) 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 306  -  TEST 010  ****
C
C     TEST 010 TESTS THE SPECIFYING OF MORE THAN ONE TYPING IN ONE
C     IMPLICIT STATEMENT.
C
      IVTNUM =  10
      IF (ICZERO) 30100, 0100, 30100
 0100 CONTINUE
      SVIN01 = 4
      TVIN01 = 4
      UVIN01 = 4
      VVIN01 = 4
      RVCMP1 = SVIN01/5
      RVCMP2 = TVIN01/5
      RVCMP3 = UVIN01/5
      RVCMP4 = VVIN01/5
      IVCOMP = 1
      IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2
      IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3
      IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5
      IF (RVCMP4 .EQ. 0.0) IVCOMP = IVCOMP * 7
      IVCORR = 210
C     210 = 2 * 3 * 5 * 7
      IF (IVCOMP - 210) 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 306  -  TEST 011  ****
C
C     TEST 011 TESTS THE SPECIFYING OF INTEGER, REAL, AND LOGICAL
C     TYPING IN ONE IMPLICIT STATEMENT.  IN THIS TEST INTEGER TYPING
C     IS REPEATED A SECOND TIME.
C
      IVTNUM =  11
      IF (ICZERO) 30110, 0110, 30110
 0110 CONTINUE
      WVIN01 = 4
      XVIN01 = 4
      YVIN01 = .TRUE.
      ZVIN01 = 4
      RVCMP1 = WVIN01/5
      RVCMP2 = XVIN01/5
      LVCOMP = YVIN01
      RVCMP3 = ZVIN01/5
      IVCOMP = 1
      IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2
      IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) IVCOMP=IVCOMP*3
      IF (LVCOMP) IVCOMP = IVCOMP * 5
      IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 7
      IVCORR = 210
C     210 = 2 * 3 * 5 * 7
40110 IF (IVCOMP - 210) 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 306  -  TEST 012  ****
C
C     TEST 012 TESTS THE SPECIFYING OF REAL TYPING TWICE IN ONE
C     IMPLICIT STATEMENT.
C
      IVTNUM =  12
      IF (ICZERO) 30120, 0120, 30120
 0120 CONTINUE
      MVIN01 = 4
      NVIN01 = 4
      RVCMP1 = MVIN01/5
      RVCMP2 = NVIN01/5
      IVCOMP = 1
      IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2
      IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) IVCOMP=IVCOMP*3
      IVCORR = 6
C     6 = 2 * 3
      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
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,5HFM306)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM306)
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