PROGRAM FM328
C
C
C          THIS ROUTINE TEST SUBSET LEVEL FEATURES OF
C     SUBROUTINE SUBPROGRAMS.  TESTS ARE DESIGNED TO CHECK THE
C     ASSOCIATION OF ALL PERMISSIBLE FORMS OF ACTUAL ARGUMENTS WITH
C     VARIABLE, ARRAY AND PROCEDURE NAME DUMMY ARGUMENTS.  THESE
C     INCLUDE,
C
C          1) ACTUAL ARGUMENTS ASSOCIATED TO VARIABLE NAME DUMMY
C             ARGUMENT INCLUDE,
C
C             A) CONSTANT
C             B) VARIABLE NAME
C             C) ARRAY ELEMENT NAME
C             D) EXPRESSION INVOLVING OPERATORS
C             E) EXPRESSION ENCLOSED IN PARENTHESES
C             F) INTRINSIC FUNCTION REFERENCE
C             G) EXTERNAL FUNCTION REFERENCE
C             H) STATEMENT FUNCTION REFERENCE
C             I) ACTUAL ARGUMENT NAME SAME AS DUMMY ARGUMENT NAME
C
C          2) ACTUAL ARGUMENTS ASSOCIATED TO ARRAY NAME DUMMY
C             ARGUMENT INCLUDE,
C
C             A) ARRAY NAME
C             B) ARRAY ELEMENT NAME
C
C          3) ACTUAL ARGUMENTS ASSOCIATED TO PROCEDURE NAME DUMMY
C             ARGUMENT INCLUDE,
C
C             A) EXTERNAL FUNCTION NAME
C             B) INTRINSIC FUNCTION NAME
C             C) SUBROUTINE NAME
C
C     ALL DATA PASSED TO THE REFERENCED SUBPROGRAMS ARE PASSED VIA
C     ARGUMENT VALUES, WHILE ALL RESULTS RETURNED TO FM328 ARE
C     RETURNED VIA VARIABLES IN NAMED COMMON.   SUBSET LEVEL ROUTINES
C     FM026, FM050 AND FM056 ALSO TEST THE USE OF SUBROUTINES.
C
C     REFERENCES.
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C           X3.9-1978
C
C        SECTION 2.8,     DUMMY ARGUMENTS
C        SECTION 5.1.2.2, DUMMY ARRAY DECLARATOR
C        SECTION 5.5,     DUMMY AND ACTUAL ARRAYS
C        SECTION 8.1,     DIMENSION STATEMENT
C        SECTION 8.3,     COMMON STATEMENT
C        SECTION 8.4,     TYPE-STATEMENT
C        SECTION 8.7,     EXTERNAL STATEMENT
C        SECTION 8.8,     INTRINSIC STATEMENT
C        SECTION 15.2,    REFERENCING A FUNCTION
C        SECTION 15.3,    INTRINSIC FUNCTIONS
C        SECTION 15.5,    EXTERNAL FUNCTIONS
C        SECTION 15.6,    SUBROUTINES
C        SECTION 15.9,    ARGUMENTS AND 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
      INTEGER IATN11(2,3)
      REAL RATN11(3,4)
      INTEGER FF330
      DIMENSION IADN11(4), IADN12(4)
      DIMENSION RADN11(4), RADN12(4)
      DIMENSION LADN11(4)
      COMMON /BLK1/IVCN01, RVCN01, LVCN01
      COMMON IACN11(6), RACN11(10)
      EXTERNAL FF330, FS335
      INTRINSIC  ABS, IABS, NINT
      IFOS01(IDON04) = IDON04 + 1
      RFOS01(RDON04) = RDON04 + 1.0
      LFOS01(LDON04) = .NOT. LDON04
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     TEST 001 THROUGH TEST 013 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS
C     OF ACTUAL ARGUMENTS TO VARIABLE NAMES USED AS SUBROUTINE
C     DUMMY ARGUMENTS.  INTEGER, REAL AND LOGICAL DUMMY ARGUMENTS ARE
C     TESTED.
C
C
C     ****  FCVS PROGRAM 328  -  TEST 001  ****
C
C     USE INTEGER, REAL AND LOGICAL CONSTANTS AS ACTUAL ARGUMENTS.
C
      IVTNUM =   1
      IF (ICZERO) 30010, 0010, 30010
 0010 CONTINUE
      CALL FS329(3, 3.0, .FALSE.)
      IVCOMP = 1
      IF (IVCN01 .EQ. 4) IVCOMP = IVCOMP * 2
      IF (RVCN01 .GE. 3.9995 .AND. RVCN01 .LE. 4.0005) IVCOMP = IVCOMP*3
      IF (LVCN01) IVCOMP = IVCOMP * 5
      IVCORR = 30
40010 IF (IVCOMP - 30) 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 328  -  TEST 002  ****
C
C     USE INTEGER, REAL AND LOGICAL VARIABLES AS ACTUAL ARGUMENTS.
C
      IVTNUM =   2
      IF (ICZERO) 30020, 0020, 30020
 0020 CONTINUE
      IVON01 = 7
      RVON01 = 7.0
      LVON01 = .TRUE.
      CALL FS329(IVON01, RVON01, LVON01)
      IVCOMP = 1
      IF (IVCN01 .EQ. 8) IVCOMP =IVCOMP * 2
      IF (RVCN01 .GE. 7.9995 .AND. RVCN01 .LE. 8.0005) IVCOMP = IVCOMP*3
      IF (.NOT. LVCN01) IVCOMP = IVCOMP * 5
      IVCORR = 30
40020 IF (IVCOMP - 30) 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 328  -  TEST 003  ****
C
C     USE INTEGER, REAL AND LOGICAL ARRAY ELEMENT NAMES AS ACTUAL
C     ARGUMENTS.
C
      IVTNUM =   3
      IF (ICZERO) 30030, 0030, 30030
 0030 CONTINUE
      IADN11(2) = 2
      RADN11(4) = 4.0
      LADN11(1) = .FALSE.
      CALL FS329(IADN11(2), RADN11(4), LADN11(1))
      IVCOMP = 1
      IF (IVCN01 .EQ. 3) IVCOMP = IVCOMP * 2
      IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*3
      IF (LVCN01) IVCOMP = IVCOMP * 5
      IVCORR = 30
40030 IF (IVCOMP - 30) 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 328  -  TEST 004  ****
C
C     INTEGER AND REAL EXPRESSIONS INVOLVING OPERATORS AS ACTUAL
C     ARGUMENTS.
C
      IVTNUM =   4
      IF (ICZERO) 30040, 0040, 30040
 0040 CONTINUE
      IVON02 = 2
      IVON03 = 3
      RVON02 = 2.
      RVON03 = 1.2
      CALL FS329(IVON02 + 3 * IVON03 - 7, RVON02 *RVON03 / .6, .TRUE.)
      IVCOMP = 1
      IF (IVCN01 .EQ. 5) IVCOMP = IVCOMP * 2
      IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*3
      IVCORR = 6
40040 IF (IVCOMP -  6) 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 328  -  TEST 005  ****
C
C     REAL EXPRESSION INVOLVING INTEGER AND REAL PRIMARIES AND OPERATORS
C     AS ACTUAL ARGUMENT.
C
      IVTNUM =   5
      IF (ICZERO) 30050, 0050, 30050
 0050 CONTINUE
      RVCOMP = 0.0
      IVON01 = 2
      RADN11(2) = 2.5
      CALL FS329(1, IVON01**3 * (RADN11(2) - 1) + 2.0, .TRUE.)
      RVCOMP = RVCN01
      RVCORR = 15.0
40050 IF (RVCOMP - 14.995) 20050, 10050, 40051
40051 IF (RVCOMP - 15.005) 10050, 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 328  -  TEST 006  ****
C
C     LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.NOT.) AS ACTUAL
C     ARGUMENT.
C
      IVTNUM =   6
      IF (ICZERO) 30060, 0060, 30060
 0060 CONTINUE
      LVON01 = .TRUE.
      CALL FS329(1, 1.0, .NOT. LVON01)
      IVCOMP = 0
      IF (LVCN01) IVCOMP = 1
      IVCORR = 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     ****  FCVS PROGRAM 328  -  TEST 007  ****
C
C     LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.OR.) AS ACTIVE
C     ARGUMENT.
C
      IVTNUM =   7
      IF (ICZERO) 30070, 0070, 30070
 0070 CONTINUE
      LVON01 = .TRUE.
      LVON02 = .FALSE.
      CALL FS329(1, 1.0, LVON01 .OR. LVON02)
      IVCOMP = 0
      IF (.NOT. LVCN01) IVCOMP = 1
      IVCORR = 1
40070 IF (IVCOMP - 1) 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 328  -  TEST 008  ****
C
C     LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.AND.) AS ACTUAL
C     ARGUMENT.
C
      IVTNUM =   8
      IF (ICZERO) 30080, 0080, 30080
 0080 CONTINUE
      LVON01 = .FALSE.
      LVON02 = .TRUE.
      CALL FS329(1, 1.0, LVON01 .AND. LVON02)
      IVCOMP = 0
      IF (LVCN01) IVCOMP = 1
      IVCORR = 1
40080 IF (IVCOMP - 1) 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 328  -  TEST 009  ****
C
C     EXPRESSION ENCLOSED IN PARENTHESES AS ACTUAL ARGUMENT.
C
      IVTNUM =   9
      IF (ICZERO) 30090, 0090, 30090
 0090 CONTINUE
      IVCOMP = 0
      IVON01 = 6
      CALL FS329((IVON01 + 3), 1.0, .TRUE.)
      IVCOMP = IVCN01
      IVCORR = 10
40090 IF (IVCOMP - 10) 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 328  -  TEST 010  ****
C
C     INTEGER AND REAL INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS
C
      IVTNUM =  10
      IF (ICZERO) 30100, 0100, 30100
 0100 CONTINUE
      RVON01 = 4.7
      RVON02 = -5.2
      CALL FS329(NINT(RVON01), ABS(RVON02), .TRUE.)
      IVCOMP = 1
      IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2
      IF (RVCN01 .GE. 6.1995 .AND. RVCN01 .LE. 6.2005) IVCOMP = IVCOMP*3
      IVCORR = 6
40100 IF (IVCOMP -  6) 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 328  -  TEST 011  ****
C
C     EXTERNAL FUNCTION REFERENCE AS ACTUAL ARGUMENT.
C
      IVTNUM =  11
      IF (ICZERO) 30110, 0110, 30110
 0110 CONTINUE
      IVCOMP = 0
      IVON01 = 4
      CALL FS329(FF330(IVON01), 1.0, .TRUE.)
      IVCOMP = IVCN01
      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 328  -  TEST 012  ****
C
C     USE ACTUAL ARGUMENT NAMES WHICH ARE IDENTICAL TO THE DUMMY
C     ARGUMENT NAMES.
C
      IVTNUM =  12
      IF (ICZERO) 30120, 0120, 30120
 0120 CONTINUE
      IDON01 = 10
      RDON01 = 10.0
      LDON01 = .FALSE.
      CALL FS329(IDON01, RDON01, LDON01)
      IVCOMP = 1
      IF (IVCN01 .EQ. 11) IVCOMP = IVCOMP * 2
      IF (RVCN01 .GE. 10.995 .AND. RVCN01 .LE. 11.005) IVCOMP = IVCOMP*3
      IF (LVCN01) IVCOMP = IVCOMP * 5
      IVCORR = 30
40120 IF (IVCOMP - 30) 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 328  -  TEST 013  ****
C
C     USE INTEGER, REAL AND LOGICAL STATEMENT FUNCTION REFERENCES AS
C     ARGUMENT NAMES.
C
      IVTNUM =  13
      IF (ICZERO) 30130, 0130, 30130
 0130 CONTINUE
      RVON01 = 5.0
      CALL FS329(IFOS01(4), RFOS01(RVON01), LFOS01(.TRUE.))
      IVCOMP = 1
      IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2
      IF (RVCN01 .GE. 6.9995 .AND. RVCN01 .LE. 7.0005) IVCOMP = IVCOMP*3
      IF (LVCN01) IVCOMP = IVCOMP * 5
      IVCORR = 30
40130 IF (IVCOMP - 30) 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     TEST 014 THROUGH TEST 019 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS
C     OF ACTUAL ARGUMENTS TO ARRAY NAMES USED AS SUBROUTINE DUMMY
C     ARGUMENTS.
C
C
C     ****  FCVS PROGRAM 328  -  TEST 014  ****
C
C     USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL
C     ARGUMENT ARRAY DECLARATOR IS IDENTICAL TO THE ASSOCIATED DUMMY
C     ARGUMENT ARRAY DECLARATOR.
C
      IVTNUM =  14
      IF (ICZERO) 30140, 0140, 30140
 0140 CONTINUE
      IVCOMP = 0
      IADN12(1) = 1
      IADN12(2) = 10
      IADN12(3) = 100
      IADN12(4) = 1000
      CALL FS331(IADN12)
      IVCOMP = IVCN01
      IVCORR = 1111
40140 IF (IVCOMP - 1111) 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 328  -  TEST 015  ****
C
C     USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE OF THE
C     ACTUAL ARGUMENT ARRAY IS LARGER THAN THE SIZE OF THE ASSOCIATED
C     DUMMY ARGUMENT ARRAY.
C
      IVTNUM =  15
      IF (ICZERO) 30150, 0150, 30150
 0150 CONTINUE
      IVCOMP = 0
      IACN11(1) = 1
      IACN11(2) = 10
      IACN11(3) = 100
      IACN11(4) = 1000
      IACN11(5) = 10000
      CALL FS331(IACN11)
      IVCOMP = IVCN01
      IVCORR = 1111
40150 IF (IVCOMP - 1111) 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 328  -  TEST 016  ****
C
C     USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL
C     ARGUMENT ARRAY DECLARATOR IS LARGER AND HAS MORE SUBSCRIPT
C     EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR.
C
      IVTNUM =  16
      IF (ICZERO) 30160, 0160, 30160
 0160 CONTINUE
      IVCOMP = 0
      IATN11(1,1) = 1
      IATN11(2,1) = 10
      IATN11(1,2) = 100
      IATN11(2,2) = 1000
      IATN11(1,3) = 10000
      CALL FS331(IATN11)
      IVCOMP = IVCN01
      IVCORR = 1111
40160 IF (IVCOMP - 1111) 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     ****  FCVS PROGRAM 328  -  TEST 017  ****
C
C     USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE
C     ASSOCIATED ACTUAL AND DUMMY ARRAY DECLARATORS ARE IDENTICAL.  ALL
C     ARRAY ELEMENTS OF THE ACTUAL ARRAY SHOULD BE PASSED TO THE
C     DUMMY ARRAY OF THE SUBROUTINE.
C
      IVTNUM =  17
      IF (ICZERO) 30170, 0170, 30170
 0170 CONTINUE
      RVCOMP = 0.0
      RADN12(1) = 1.
      RADN12(2) = 10.
      RADN12(3) = 100.
      RADN12(4) = 1000.
      CALL FS332(RADN12(1))
      RVCOMP = RVCN01
      RVCORR = 1111.
40170 IF (RVCOMP - 1110.5) 20170, 10170, 40171
40171 IF (RVCOMP - 1111.5) 10170, 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,80012) IVTNUM, RVCOMP, RVCORR
 0181 CONTINUE
C
C     ****  FCVS PROGRAM 328  -  TEST 018  ****
C
C     USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE
C     OF THE ACTUAL ARGUMENT ARRAY IS LARGER AND HAS FEWER SUBSCRIPT
C     EXPRESSIONS THAN THE ASSOCIATED DUMMY ARRAY.  ONLY ACTUAL ARRAY
C     ELEMENTS WITH SUBSCRIPT VALUES OF 5, 6, 7 AND 8 ( OUT OF A
C     POSSIBLE 10 ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF
C     THE SUBROUTINE.
C
      IVTNUM =  18
      IF (ICZERO) 30180, 0180, 30180
 0180 CONTINUE
      RVCOMP = 0.0
      RACN11(4) = 1.
      RACN11(5) = 10.
      RACN11(6) = 100.
      RACN11(7) = 1000.
      RACN11(8) = 10000.
      RACN11(9) = 100000.
      CALL FS332(RACN11(5))
      RVCOMP = RVCN01
      RVCORR =  11110.
40180 IF (RVCOMP - 11105.) 20180, 10180, 40181
40181 IF (RVCOMP - 11115.) 10180, 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,80012) IVTNUM, RVCOMP, RVCORR
 0191 CONTINUE
C
C     ****  FCVS PROGRAM 328  -  TEST 019  ****
C
C     USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE
C     OF THE ACTUAL ARGUMENT ARRAY IS LARGE THAN THE SIZE OF THE
C     ASSOCIATED DUMMY ARGUMENT ARRAY.  ONLY ACTUAL ARRAY ELEMENTS WITH
C     SUBSCRIPT VALUES OF 9, 10, 11 AND 12 (OUT OF A POSSIBLE 12
C     ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE SUBROUTINE.
C
      IVTNUM =  19
      IF (ICZERO) 30190, 0190, 30190
 0190 CONTINUE
      RVCOMP = 0.0
      RATN11(2,3) = 1.
      RATN11(3,3) = 10.
      RATN11(1,4) = 100.
      RATN11(2,4) = 1000.
      RATN11(3,4) = 10000.
      CALL FS332(RATN11(3,3))
      RVCOMP = RVCN01
      RVCORR = 11110.
40190 IF (RVCOMP - 11105.) 20190, 10190, 40191
40191 IF (RVCOMP - 11115.) 10190, 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,80012) IVTNUM, RVCOMP, RVCORR
 0201 CONTINUE
C
C     TEST 020 THROUGH TEST 022 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS
C     OF ACTUAL ARGUMENTS TO PROCEDURES USED AS SUBROUTINE DUMMY
C     ARGUMENTS.  ACTUAL ARGUMENTS TESTED INCLUDE THE NAMES OF AN
C     EXTERNAL FUNCTION, AN INTRINSIC FUNCTION AND A SUBROUTINE.
C
C
C     ****  FCVS PROGRAM 328  -  TEST 020  ****
C
C     USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT.
C
      IVTNUM =  20
      IF (ICZERO) 30200, 0200, 30200
 0200 CONTINUE
      IVCOMP = 0
      CALL FS333(FF330, 5)
      IVCOMP = IVCN01
      IVCORR = 7
40200 IF (IVCOMP - 7) 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     ****  FCVS PROGRAM 328  -  TEST 021  ****
C
C     USE AN INTRINSIC FUNCTION NAME AS AN ACTUAL ARGUMENT.
C
      IVTNUM =  21
      IF (ICZERO) 30210, 0210, 30210
 0210 CONTINUE
      IVCOMP = 0
      CALL FS333(IABS, -7)
      IVCOMP = IVCN01
      IVCORR = 8
40210 IF (IVCOMP - 8) 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 328  -  TEST 022  ****
C
C     USE A SUBROUTINE NAME AS AN ACTUAL ARGUMENT.
C
      IVTNUM =  22
      IF (ICZERO) 30220, 0220, 30220
 0220 CONTINUE
      RVCOMP = 0.0
      RVON01 = 3.5
      CALL FS334(FS335, RVON01)
      RVCOMP = RVCN01
      RVCORR = 5.5
40220 IF (RVCOMP - 5.4995) 20220, 10220, 40221
40221 IF (RVCOMP - 5.5005) 10220, 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,80012) IVTNUM, RVCOMP, RVCORR
 0231 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,5HFM328)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM328)
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 FS329(IDON01, RDON01, LDON01)
C          THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM
C     FM328 TO TEST THE DIFFERENT FORMS OF INTEGER, REAL AND LOGICAL
C     ACTUAL ARGUMENTS THAT CAN BE ASSOCIATED WITH INTEGER, REAL AND
C     LOGICAL DUMMY ARGUMENTS.  THIS ROUTINE INCREMENTS THE INTEGER
C     AND REAL ARGUMENTS BY ONE AND NEGATES THE LOGICAL ARGUMENT.  ALL
C     RESULTS ARE THEN RETURNED TO FM328 VIA VARIABLES IN NAMED COMMON.
      IMPLICIT LOGICAL (L)
      COMMON /BLK1/ IVCN01, RVCN01, LVCN01
      IVCN01 = IDON01 + 1
      RVCN01 = RDON01 + 1.0
      LVCN01 = .NOT. LDON01
      RETURN
      END
      INTEGER FUNCTION FF330(IDON02)
C         THIS FUNCTION IS USED BY TEST 011 OF THE MAIN PROGRAM FM328 TO
C     TEST THE USE OF AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL
C     ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS A VARIABLE NAME.
C     THIS FUNCTION IS ALSO REFERENCED FROM SUBROUTINE FS333 VIA A
C     DUMMY PROCEDURE NAME REFERENCE.  THIS FUNCTION INCREMENTS THE
C     ARGUMENT VALUE BY ONE AND RETURNS THE RESULT AS THE FUNCTION
C     VALUE.
      FF330 = IDON02 + 1
      RETURN
      END
      SUBROUTINE FS331(IDDN11)
C          THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM
C     FM328 TO TEST THE USE OF AN ARRAY NAME AS AN ACTUAL ARGUMENT WHEN
C     THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME.  THIS ROUTINE
C     ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY ARGUMENT ARRAY AND
C     RETURNS THE RESULTS VIA A VARIABLE IN NAMED COMMON.
      LOGICAL LVCN01
      DIMENSION IDDN11(4)
      COMMON /BLK1/IVCN01, RVCN01, LVCN01
      IVCN01 = IDDN11(1) + IDDN11(2) + IDDN11(3) + IDDN11(4)
      RETURN
      END
      SUBROUTINE FS332(RDTN21)
C          THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM
C     FM328 TO TEST THE USE OF AN ARRAY ELEMENT NAME AS AN ACTUAL
C     ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME.
C     THIS ROUTINE ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY
C     ARGUMENT ARRAY AND RETURNS THE RESULT VIA A VARIABLE IN NAMED
C     COMMON.
      IMPLICIT LOGICAL (L)
      REAL RDTN21(2,2)
      COMMON /BLK1/IVCN01, RVCN01, LVCN01
      RVCN01 = RDTN21(1,1) + RDTN21(2,1) + RDTN21(1,2) + RDTN21(2,2)
      RETURN
      END
      SUBROUTINE FS333(NINT, IDON03)
C          THIS SUBROUTINE IS USED BY TESTS 020 AND 021 OF THE MAIN
C     PROGRAM FM328 TO TEST THE USE OF EXTERNAL AND INTRINSIC FUNCTION
C     NAMES AS ACTUAL ARGUMENTS WHEN THE ASSOCIATED DUMMY ARGUMENT IS A
C     PROCEDURE NAME.  THIS SUBROUTINE REFERENCES THE EXTERNAL FUNCTION
C     FF330 OR THE INTRINSIC FUNCTION IABS DEPENDING ON THE ACTUAL
C     ARGUMENT PASSED TO IT.  THE RESULT OF THIS FUNCTION REFERENCE IS
C     THEN INCREMENTED BY ONE AND THE RESULT IS RETURNED TO FS328 VIA
C     A VARIABLE IN NAMED COMMON.
      IMPLICIT LOGICAL (L)
      COMMON /BLK1/IVCN01, RVCN01, LVCN01
      IVCN01 = NINT(IDON03) + 1
C              **** THE NAME NINT IS A DUMMY ARGUMENT NAME
C                     AND NOT AN INTRINSIC FUNCTION REFERENCE ****
      RETURN
      END
      SUBROUTINE FS334(IDON06, RDON03)
C          THIS SUBROUTINE IS USED BY TEST 022 OF THE MAIN PROGRAM
C     FM328 TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT
C     WHEN THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME.  THIS
C     SUBROUTINE CALLS THE SUBROUTINE FS335 VIA A DUMMY PROCEDURE NAME
C     REFERENCE.  THE ARGUMENT VALUE WHICH IS RETURNED FROM THE FS335
C     REFERENCE IS THEN INCREMENTED BY ONE AND RETURNED TO FM328 VIA
C     A VARIABLE IN NAMED COMMON.
      IMPLICIT LOGICAL (L)
      COMMON /BLK1/IVCN01, RVCN01, LVCN01
      CALL IDON06(RDON03)
      RVCN01 = RDON03 + 1.0
      RETURN
      END
      SUBROUTINE FS335(RDON04)
C          THIS SUBROUITNE IS USED BY TEST 022 OF THE MAIN PROGRAM FM328
C     TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT WHEN
C     THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME.  FS335 IS
C     CALLED FROM SUBROUTINE FS334 VIA A DUMMY PROCEDURE NAME REFERENCE.
C     THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY ONE.
      RDON04 = RDON04 + 1.0
      RETURN
      END