FM328.f Source File


Contents

Source Code


Source Code

      PROGRAM FM328                                                     00010328
C                                                                       00020328
C                                                                       00030328
C          THIS ROUTINE TEST SUBSET LEVEL FEATURES OF                   00040328
C     SUBROUTINE SUBPROGRAMS.  TESTS ARE DESIGNED TO CHECK THE          00050328
C     ASSOCIATION OF ALL PERMISSIBLE FORMS OF ACTUAL ARGUMENTS WITH     00060328
C     VARIABLE, ARRAY AND PROCEDURE NAME DUMMY ARGUMENTS.  THESE        00070328
C     INCLUDE,                                                          00080328
C                                                                       00090328
C          1) ACTUAL ARGUMENTS ASSOCIATED TO VARIABLE NAME DUMMY        00100328
C             ARGUMENT INCLUDE,                                         00110328
C                                                                       00120328
C             A) CONSTANT                                               00130328
C             B) VARIABLE NAME                                          00140328
C             C) ARRAY ELEMENT NAME                                     00150328
C             D) EXPRESSION INVOLVING OPERATORS                         00160328
C             E) EXPRESSION ENCLOSED IN PARENTHESES                     00170328
C             F) INTRINSIC FUNCTION REFERENCE                           00180328
C             G) EXTERNAL FUNCTION REFERENCE                            00190328
C             H) STATEMENT FUNCTION REFERENCE                           00200328
C             I) ACTUAL ARGUMENT NAME SAME AS DUMMY ARGUMENT NAME       00210328
C                                                                       00220328
C          2) ACTUAL ARGUMENTS ASSOCIATED TO ARRAY NAME DUMMY           00230328
C             ARGUMENT INCLUDE,                                         00240328
C                                                                       00250328
C             A) ARRAY NAME                                             00260328
C             B) ARRAY ELEMENT NAME                                     00270328
C                                                                       00280328
C          3) ACTUAL ARGUMENTS ASSOCIATED TO PROCEDURE NAME DUMMY       00290328
C             ARGUMENT INCLUDE,                                         00300328
C                                                                       00310328
C             A) EXTERNAL FUNCTION NAME                                 00320328
C             B) INTRINSIC FUNCTION NAME                                00330328
C             C) SUBROUTINE NAME                                        00340328
C                                                                       00350328
C     ALL DATA PASSED TO THE REFERENCED SUBPROGRAMS ARE PASSED VIA      00360328
C     ARGUMENT VALUES, WHILE ALL RESULTS RETURNED TO FM328 ARE          00370328
C     RETURNED VIA VARIABLES IN NAMED COMMON.   SUBSET LEVEL ROUTINES   00380328
C     FM026, FM050 AND FM056 ALSO TEST THE USE OF SUBROUTINES.          00390328
C                                                                       00400328
C     REFERENCES.                                                       00410328
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00420328
C           X3.9-1978                                                   00430328
C                                                                       00440328
C        SECTION 2.8,     DUMMY ARGUMENTS                               00450328
C        SECTION 5.1.2.2, DUMMY ARRAY DECLARATOR                        00460328
C        SECTION 5.5,     DUMMY AND ACTUAL ARRAYS                       00470328
C        SECTION 8.1,     DIMENSION STATEMENT                           00480328
C        SECTION 8.3,     COMMON STATEMENT                              00490328
C        SECTION 8.4,     TYPE-STATEMENT                                00500328
C        SECTION 8.7,     EXTERNAL STATEMENT                            00510328
C        SECTION 8.8,     INTRINSIC STATEMENT                           00520328
C        SECTION 15.2,    REFERENCING A FUNCTION                        00530328
C        SECTION 15.3,    INTRINSIC FUNCTIONS                           00540328
C        SECTION 15.5,    EXTERNAL FUNCTIONS                            00550328
C        SECTION 15.6,    SUBROUTINES                                   00560328
C        SECTION 15.9,    ARGUMENTS AND COMMON BLOCKS                   00570328
C                                                                       00580328
C                                                                       00590328
C     ******************************************************************00600328
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00610328
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN   00620328
C     X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY.  THE 00630328
C     FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT       00640328
C     ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT00650328
C     ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS   00660328
C     OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00670328
C     THE RESULT OF EXECUTING THESE TESTS.                              00680328
C                                                                       00690328
C     THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES      00700328
C     FOUND IN THE SUBSET LEVEL OF THE STANDARD.                        00710328
C                                                                       00720328
C           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO             00730328
C              NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00740328
C                   SOFTWARE STANDARDS VALIDATION GROUP                 00750328
C                          BUILDING 225  RM A266                        00760328
C                         GAITHERSBURG, MD  20899                       00770328
C     ******************************************************************00780328
C                                                                       00790328
C                                                                       00800328
      IMPLICIT LOGICAL (L)                                              00810328
      IMPLICIT CHARACTER*14 (C)                                         00820328
C                                                                       00830328
      INTEGER IATN11(2,3)                                               00840328
      REAL RATN11(3,4)                                                  00850328
      INTEGER FF330                                                     00860328
      DIMENSION IADN11(4), IADN12(4)                                    00870328
      DIMENSION RADN11(4), RADN12(4)                                    00880328
      DIMENSION LADN11(4)                                               00890328
      COMMON /BLK1/IVCN01, RVCN01, LVCN01                               00900328
      COMMON IACN11(6), RACN11(10)                                      00910328
      EXTERNAL FF330, FS335                                             00920328
      INTRINSIC  ABS, IABS, NINT                                        00930328
      IFOS01(IDON04) = IDON04 + 1                                       00940328
      RFOS01(RDON04) = RDON04 + 1.0                                     00950328
      LFOS01(LDON04) = .NOT. LDON04                                     00960328
C                                                                       00970328
C                                                                       00980328
C                                                                       00990328
C     INITIALIZATION SECTION.                                           01000328
C                                                                       01010328
C     INITIALIZE CONSTANTS                                              01020328
C     ********************                                              01030328
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER          01040328
      I01 = 5                                                           01050328
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER              01060328
      I02 = 6                                                           01070328
C     SYSTEM ENVIRONMENT SECTION                                        01080328
C                                                                       01090328
CX010     THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01100328
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      01110328
C     (UNIT NUMBER FOR CARD READER).                                    01120328
CX011      THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01130328
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            01140328
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         01150328
C                                                                       01160328
CX020     THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01170328
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      01180328
C     (UNIT NUMBER FOR PRINTER).                                        01190328
CX021     THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01200328
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            01210328
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         01220328
C                                                                       01230328
      IVPASS = 0                                                        01240328
      IVFAIL = 0                                                        01250328
      IVDELE = 0                                                        01260328
      ICZERO = 0                                                        01270328
C                                                                       01280328
C     WRITE OUT PAGE HEADERS                                            01290328
C                                                                       01300328
      WRITE (I02,90002)                                                 01310328
      WRITE (I02,90006)                                                 01320328
      WRITE (I02,90008)                                                 01330328
      WRITE (I02,90004)                                                 01340328
      WRITE (I02,90010)                                                 01350328
      WRITE (I02,90004)                                                 01360328
      WRITE (I02,90016)                                                 01370328
      WRITE (I02,90001)                                                 01380328
      WRITE (I02,90004)                                                 01390328
      WRITE (I02,90012)                                                 01400328
      WRITE (I02,90014)                                                 01410328
      WRITE (I02,90004)                                                 01420328
C                                                                       01430328
C                                                                       01440328
C     TEST 001 THROUGH TEST 013 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 01450328
C     OF ACTUAL ARGUMENTS TO VARIABLE NAMES USED AS SUBROUTINE          01460328
C     DUMMY ARGUMENTS.  INTEGER, REAL AND LOGICAL DUMMY ARGUMENTS ARE   01470328
C     TESTED.                                                           01480328
C                                                                       01490328
C                                                                       01500328
C     ****  FCVS PROGRAM 328  -  TEST 001  ****                         01510328
C                                                                       01520328
C     USE INTEGER, REAL AND LOGICAL CONSTANTS AS ACTUAL ARGUMENTS.      01530328
C                                                                       01540328
      IVTNUM =   1                                                      01550328
      IF (ICZERO) 30010, 0010, 30010                                    01560328
 0010 CONTINUE                                                          01570328
      CALL FS329(3, 3.0, .FALSE.)                                       01580328
      IVCOMP = 1                                                        01590328
      IF (IVCN01 .EQ. 4) IVCOMP = IVCOMP * 2                            01600328
      IF (RVCN01 .GE. 3.9995 .AND. RVCN01 .LE. 4.0005) IVCOMP = IVCOMP*301610328
      IF (LVCN01) IVCOMP = IVCOMP * 5                                   01620328
      IVCORR = 30                                                       01630328
40010 IF (IVCOMP - 30) 20010, 10010, 20010                              01640328
30010 IVDELE = IVDELE + 1                                               01650328
      WRITE (I02,80000) IVTNUM                                          01660328
      IF (ICZERO) 10010, 0021, 20010                                    01670328
10010 IVPASS = IVPASS + 1                                               01680328
      WRITE (I02,80002) IVTNUM                                          01690328
      GO TO 0021                                                        01700328
20010 IVFAIL = IVFAIL + 1                                               01710328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          01720328
 0021 CONTINUE                                                          01730328
C                                                                       01740328
C     ****  FCVS PROGRAM 328  -  TEST 002  ****                         01750328
C                                                                       01760328
C     USE INTEGER, REAL AND LOGICAL VARIABLES AS ACTUAL ARGUMENTS.      01770328
C                                                                       01780328
      IVTNUM =   2                                                      01790328
      IF (ICZERO) 30020, 0020, 30020                                    01800328
 0020 CONTINUE                                                          01810328
      IVON01 = 7                                                        01820328
      RVON01 = 7.0                                                      01830328
      LVON01 = .TRUE.                                                   01840328
      CALL FS329(IVON01, RVON01, LVON01)                                01850328
      IVCOMP = 1                                                        01860328
      IF (IVCN01 .EQ. 8) IVCOMP =IVCOMP * 2                             01870328
      IF (RVCN01 .GE. 7.9995 .AND. RVCN01 .LE. 8.0005) IVCOMP = IVCOMP*301880328
      IF (.NOT. LVCN01) IVCOMP = IVCOMP * 5                             01890328
      IVCORR = 30                                                       01900328
40020 IF (IVCOMP - 30) 20020, 10020, 20020                              01910328
30020 IVDELE = IVDELE + 1                                               01920328
      WRITE (I02,80000) IVTNUM                                          01930328
      IF (ICZERO) 10020, 0031, 20020                                    01940328
10020 IVPASS = IVPASS + 1                                               01950328
      WRITE (I02,80002) IVTNUM                                          01960328
      GO TO 0031                                                        01970328
20020 IVFAIL = IVFAIL + 1                                               01980328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          01990328
 0031 CONTINUE                                                          02000328
C                                                                       02010328
C     ****  FCVS PROGRAM 328  -  TEST 003  ****                         02020328
C                                                                       02030328
C     USE INTEGER, REAL AND LOGICAL ARRAY ELEMENT NAMES AS ACTUAL       02040328
C     ARGUMENTS.                                                        02050328
C                                                                       02060328
      IVTNUM =   3                                                      02070328
      IF (ICZERO) 30030, 0030, 30030                                    02080328
 0030 CONTINUE                                                          02090328
      IADN11(2) = 2                                                     02100328
      RADN11(4) = 4.0                                                   02110328
      LADN11(1) = .FALSE.                                               02120328
      CALL FS329(IADN11(2), RADN11(4), LADN11(1))                       02130328
      IVCOMP = 1                                                        02140328
      IF (IVCN01 .EQ. 3) IVCOMP = IVCOMP * 2                            02150328
      IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*302160328
      IF (LVCN01) IVCOMP = IVCOMP * 5                                   02170328
      IVCORR = 30                                                       02180328
40030 IF (IVCOMP - 30) 20030, 10030, 20030                              02190328
30030 IVDELE = IVDELE + 1                                               02200328
      WRITE (I02,80000) IVTNUM                                          02210328
      IF (ICZERO) 10030, 0041, 20030                                    02220328
10030 IVPASS = IVPASS + 1                                               02230328
      WRITE (I02,80002) IVTNUM                                          02240328
      GO TO 0041                                                        02250328
20030 IVFAIL = IVFAIL + 1                                               02260328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          02270328
 0041 CONTINUE                                                          02280328
C                                                                       02290328
C     ****  FCVS PROGRAM 328  -  TEST 004  ****                         02300328
C                                                                       02310328
C     INTEGER AND REAL EXPRESSIONS INVOLVING OPERATORS AS ACTUAL        02320328
C     ARGUMENTS.                                                        02330328
C                                                                       02340328
      IVTNUM =   4                                                      02350328
      IF (ICZERO) 30040, 0040, 30040                                    02360328
 0040 CONTINUE                                                          02370328
      IVON02 = 2                                                        02380328
      IVON03 = 3                                                        02390328
      RVON02 = 2.                                                       02400328
      RVON03 = 1.2                                                      02410328
      CALL FS329(IVON02 + 3 * IVON03 - 7, RVON02 *RVON03 / .6, .TRUE.)  02420328
      IVCOMP = 1                                                        02430328
      IF (IVCN01 .EQ. 5) IVCOMP = IVCOMP * 2                            02440328
      IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*302450328
      IVCORR = 6                                                        02460328
40040 IF (IVCOMP -  6) 20040, 10040, 20040                              02470328
30040 IVDELE = IVDELE + 1                                               02480328
      WRITE (I02,80000) IVTNUM                                          02490328
      IF (ICZERO) 10040, 0051, 20040                                    02500328
10040 IVPASS = IVPASS + 1                                               02510328
      WRITE (I02,80002) IVTNUM                                          02520328
      GO TO 0051                                                        02530328
20040 IVFAIL = IVFAIL + 1                                               02540328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          02550328
 0051 CONTINUE                                                          02560328
C                                                                       02570328
C     ****  FCVS PROGRAM 328  -  TEST 005  ****                         02580328
C                                                                       02590328
C     REAL EXPRESSION INVOLVING INTEGER AND REAL PRIMARIES AND OPERATORS02600328
C     AS ACTUAL ARGUMENT.                                               02610328
C                                                                       02620328
      IVTNUM =   5                                                      02630328
      IF (ICZERO) 30050, 0050, 30050                                    02640328
 0050 CONTINUE                                                          02650328
      RVCOMP = 0.0                                                      02660328
      IVON01 = 2                                                        02670328
      RADN11(2) = 2.5                                                   02680328
      CALL FS329(1, IVON01**3 * (RADN11(2) - 1) + 2.0, .TRUE.)          02690328
      RVCOMP = RVCN01                                                   02700328
      RVCORR = 15.0                                                     02710328
40050 IF (RVCOMP - 14.995) 20050, 10050, 40051                          02720328
40051 IF (RVCOMP - 15.005) 10050, 10050, 20050                          02730328
30050 IVDELE = IVDELE + 1                                               02740328
      WRITE (I02,80000) IVTNUM                                          02750328
      IF (ICZERO) 10050, 0061, 20050                                    02760328
10050 IVPASS = IVPASS + 1                                               02770328
      WRITE (I02,80002) IVTNUM                                          02780328
      GO TO 0061                                                        02790328
20050 IVFAIL = IVFAIL + 1                                               02800328
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          02810328
 0061 CONTINUE                                                          02820328
C                                                                       02830328
C     ****  FCVS PROGRAM 328  -  TEST 006  ****                         02840328
C                                                                       02850328
C     LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.NOT.) AS ACTUAL   02860328
C     ARGUMENT.                                                         02870328
C                                                                       02880328
      IVTNUM =   6                                                      02890328
      IF (ICZERO) 30060, 0060, 30060                                    02900328
 0060 CONTINUE                                                          02910328
      LVON01 = .TRUE.                                                   02920328
      CALL FS329(1, 1.0, .NOT. LVON01)                                  02930328
      IVCOMP = 0                                                        02940328
      IF (LVCN01) IVCOMP = 1                                            02950328
      IVCORR = 1                                                        02960328
40060 IF (IVCOMP - 1) 20060, 10060, 20060                               02970328
30060 IVDELE = IVDELE + 1                                               02980328
      WRITE (I02,80000) IVTNUM                                          02990328
      IF (ICZERO) 10060, 0071, 20060                                    03000328
10060 IVPASS = IVPASS + 1                                               03010328
      WRITE (I02,80002) IVTNUM                                          03020328
      GO TO 0071                                                        03030328
20060 IVFAIL = IVFAIL + 1                                               03040328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          03050328
 0071 CONTINUE                                                          03060328
C                                                                       03070328
C     ****  FCVS PROGRAM 328  -  TEST 007  ****                         03080328
C                                                                       03090328
C     LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.OR.) AS ACTIVE    03100328
C     ARGUMENT.                                                         03110328
C                                                                       03120328
      IVTNUM =   7                                                      03130328
      IF (ICZERO) 30070, 0070, 30070                                    03140328
 0070 CONTINUE                                                          03150328
      LVON01 = .TRUE.                                                   03160328
      LVON02 = .FALSE.                                                  03170328
      CALL FS329(1, 1.0, LVON01 .OR. LVON02)                            03180328
      IVCOMP = 0                                                        03190328
      IF (.NOT. LVCN01) IVCOMP = 1                                      03200328
      IVCORR = 1                                                        03210328
40070 IF (IVCOMP - 1) 20070, 10070, 20070                               03220328
30070 IVDELE = IVDELE + 1                                               03230328
      WRITE (I02,80000) IVTNUM                                          03240328
      IF (ICZERO) 10070, 0081, 20070                                    03250328
10070 IVPASS = IVPASS + 1                                               03260328
      WRITE (I02,80002) IVTNUM                                          03270328
      GO TO 0081                                                        03280328
20070 IVFAIL = IVFAIL + 1                                               03290328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          03300328
 0081 CONTINUE                                                          03310328
C                                                                       03320328
C     ****  FCVS PROGRAM 328  -  TEST 008  ****                         03330328
C                                                                       03340328
C     LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.AND.) AS ACTUAL   03350328
C     ARGUMENT.                                                         03360328
C                                                                       03370328
      IVTNUM =   8                                                      03380328
      IF (ICZERO) 30080, 0080, 30080                                    03390328
 0080 CONTINUE                                                          03400328
      LVON01 = .FALSE.                                                  03410328
      LVON02 = .TRUE.                                                   03420328
      CALL FS329(1, 1.0, LVON01 .AND. LVON02)                           03430328
      IVCOMP = 0                                                        03440328
      IF (LVCN01) IVCOMP = 1                                            03450328
      IVCORR = 1                                                        03460328
40080 IF (IVCOMP - 1) 20080, 10080, 20080                               03470328
30080 IVDELE = IVDELE + 1                                               03480328
      WRITE (I02,80000) IVTNUM                                          03490328
      IF (ICZERO) 10080, 0091, 20080                                    03500328
10080 IVPASS = IVPASS + 1                                               03510328
      WRITE (I02,80002) IVTNUM                                          03520328
      GO TO 0091                                                        03530328
20080 IVFAIL = IVFAIL + 1                                               03540328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          03550328
 0091 CONTINUE                                                          03560328
C                                                                       03570328
C     ****  FCVS PROGRAM 328  -  TEST 009  ****                         03580328
C                                                                       03590328
C     EXPRESSION ENCLOSED IN PARENTHESES AS ACTUAL ARGUMENT.            03600328
C                                                                       03610328
      IVTNUM =   9                                                      03620328
      IF (ICZERO) 30090, 0090, 30090                                    03630328
 0090 CONTINUE                                                          03640328
      IVCOMP = 0                                                        03650328
      IVON01 = 6                                                        03660328
      CALL FS329((IVON01 + 3), 1.0, .TRUE.)                             03670328
      IVCOMP = IVCN01                                                   03680328
      IVCORR = 10                                                       03690328
40090 IF (IVCOMP - 10) 20090, 10090, 20090                              03700328
30090 IVDELE = IVDELE + 1                                               03710328
      WRITE (I02,80000) IVTNUM                                          03720328
      IF (ICZERO) 10090, 0101, 20090                                    03730328
10090 IVPASS = IVPASS + 1                                               03740328
      WRITE (I02,80002) IVTNUM                                          03750328
      GO TO 0101                                                        03760328
20090 IVFAIL = IVFAIL + 1                                               03770328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          03780328
 0101 CONTINUE                                                          03790328
C                                                                       03800328
C     ****  FCVS PROGRAM 328  -  TEST 010  ****                         03810328
C                                                                       03820328
C     INTEGER AND REAL INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS03830328
C                                                                       03840328
      IVTNUM =  10                                                      03850328
      IF (ICZERO) 30100, 0100, 30100                                    03860328
 0100 CONTINUE                                                          03870328
      RVON01 = 4.7                                                      03880328
      RVON02 = -5.2                                                     03890328
      CALL FS329(NINT(RVON01), ABS(RVON02), .TRUE.)                     03900328
      IVCOMP = 1                                                        03910328
      IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2                            03920328
      IF (RVCN01 .GE. 6.1995 .AND. RVCN01 .LE. 6.2005) IVCOMP = IVCOMP*303930328
      IVCORR = 6                                                        03940328
40100 IF (IVCOMP -  6) 20100, 10100, 20100                              03950328
30100 IVDELE = IVDELE + 1                                               03960328
      WRITE (I02,80000) IVTNUM                                          03970328
      IF (ICZERO) 10100, 0111, 20100                                    03980328
10100 IVPASS = IVPASS + 1                                               03990328
      WRITE (I02,80002) IVTNUM                                          04000328
      GO TO 0111                                                        04010328
20100 IVFAIL = IVFAIL + 1                                               04020328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          04030328
 0111 CONTINUE                                                          04040328
C                                                                       04050328
C     ****  FCVS PROGRAM 328  -  TEST 011  ****                         04060328
C                                                                       04070328
C     EXTERNAL FUNCTION REFERENCE AS ACTUAL ARGUMENT.                   04080328
C                                                                       04090328
      IVTNUM =  11                                                      04100328
      IF (ICZERO) 30110, 0110, 30110                                    04110328
 0110 CONTINUE                                                          04120328
      IVCOMP = 0                                                        04130328
      IVON01 = 4                                                        04140328
      CALL FS329(FF330(IVON01), 1.0, .TRUE.)                            04150328
      IVCOMP = IVCN01                                                   04160328
      IVCORR = 6                                                        04170328
40110 IF (IVCOMP - 6) 20110, 10110, 20110                               04180328
30110 IVDELE = IVDELE + 1                                               04190328
      WRITE (I02,80000) IVTNUM                                          04200328
      IF (ICZERO) 10110, 0121, 20110                                    04210328
10110 IVPASS = IVPASS + 1                                               04220328
      WRITE (I02,80002) IVTNUM                                          04230328
      GO TO 0121                                                        04240328
20110 IVFAIL = IVFAIL + 1                                               04250328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          04260328
 0121 CONTINUE                                                          04270328
C                                                                       04280328
C     ****  FCVS PROGRAM 328  -  TEST 012  ****                         04290328
C                                                                       04300328
C     USE ACTUAL ARGUMENT NAMES WHICH ARE IDENTICAL TO THE DUMMY        04310328
C     ARGUMENT NAMES.                                                   04320328
C                                                                       04330328
      IVTNUM =  12                                                      04340328
      IF (ICZERO) 30120, 0120, 30120                                    04350328
 0120 CONTINUE                                                          04360328
      IDON01 = 10                                                       04370328
      RDON01 = 10.0                                                     04380328
      LDON01 = .FALSE.                                                  04390328
      CALL FS329(IDON01, RDON01, LDON01)                                04400328
      IVCOMP = 1                                                        04410328
      IF (IVCN01 .EQ. 11) IVCOMP = IVCOMP * 2                           04420328
      IF (RVCN01 .GE. 10.995 .AND. RVCN01 .LE. 11.005) IVCOMP = IVCOMP*304430328
      IF (LVCN01) IVCOMP = IVCOMP * 5                                   04440328
      IVCORR = 30                                                       04450328
40120 IF (IVCOMP - 30) 20120, 10120, 20120                              04460328
30120 IVDELE = IVDELE + 1                                               04470328
      WRITE (I02,80000) IVTNUM                                          04480328
      IF (ICZERO) 10120, 0131, 20120                                    04490328
10120 IVPASS = IVPASS + 1                                               04500328
      WRITE (I02,80002) IVTNUM                                          04510328
      GO TO 0131                                                        04520328
20120 IVFAIL = IVFAIL + 1                                               04530328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          04540328
 0131 CONTINUE                                                          04550328
C                                                                       04560328
C     ****  FCVS PROGRAM 328  -  TEST 013  ****                         04570328
C                                                                       04580328
C     USE INTEGER, REAL AND LOGICAL STATEMENT FUNCTION REFERENCES AS    04590328
C     ARGUMENT NAMES.                                                   04600328
C                                                                       04610328
      IVTNUM =  13                                                      04620328
      IF (ICZERO) 30130, 0130, 30130                                    04630328
 0130 CONTINUE                                                          04640328
      RVON01 = 5.0                                                      04650328
      CALL FS329(IFOS01(4), RFOS01(RVON01), LFOS01(.TRUE.))             04660328
      IVCOMP = 1                                                        04670328
      IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2                            04680328
      IF (RVCN01 .GE. 6.9995 .AND. RVCN01 .LE. 7.0005) IVCOMP = IVCOMP*304690328
      IF (LVCN01) IVCOMP = IVCOMP * 5                                   04700328
      IVCORR = 30                                                       04710328
40130 IF (IVCOMP - 30) 20130, 10130, 20130                              04720328
30130 IVDELE = IVDELE + 1                                               04730328
      WRITE (I02,80000) IVTNUM                                          04740328
      IF (ICZERO) 10130, 0141, 20130                                    04750328
10130 IVPASS = IVPASS + 1                                               04760328
      WRITE (I02,80002) IVTNUM                                          04770328
      GO TO 0141                                                        04780328
20130 IVFAIL = IVFAIL + 1                                               04790328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          04800328
 0141 CONTINUE                                                          04810328
C                                                                       04820328
C     TEST 014 THROUGH TEST 019 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 04830328
C     OF ACTUAL ARGUMENTS TO ARRAY NAMES USED AS SUBROUTINE DUMMY       04840328
C     ARGUMENTS.                                                        04850328
C                                                                       04860328
C                                                                       04870328
C     ****  FCVS PROGRAM 328  -  TEST 014  ****                         04880328
C                                                                       04890328
C     USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL       04900328
C     ARGUMENT ARRAY DECLARATOR IS IDENTICAL TO THE ASSOCIATED DUMMY    04910328
C     ARGUMENT ARRAY DECLARATOR.                                        04920328
C                                                                       04930328
      IVTNUM =  14                                                      04940328
      IF (ICZERO) 30140, 0140, 30140                                    04950328
 0140 CONTINUE                                                          04960328
      IVCOMP = 0                                                        04970328
      IADN12(1) = 1                                                     04980328
      IADN12(2) = 10                                                    04990328
      IADN12(3) = 100                                                   05000328
      IADN12(4) = 1000                                                  05010328
      CALL FS331(IADN12)                                                05020328
      IVCOMP = IVCN01                                                   05030328
      IVCORR = 1111                                                     05040328
40140 IF (IVCOMP - 1111) 20140, 10140, 20140                            05050328
30140 IVDELE = IVDELE + 1                                               05060328
      WRITE (I02,80000) IVTNUM                                          05070328
      IF (ICZERO) 10140, 0151, 20140                                    05080328
10140 IVPASS = IVPASS + 1                                               05090328
      WRITE (I02,80002) IVTNUM                                          05100328
      GO TO 0151                                                        05110328
20140 IVFAIL = IVFAIL + 1                                               05120328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          05130328
 0151 CONTINUE                                                          05140328
C                                                                       05150328
C     ****  FCVS PROGRAM 328  -  TEST 015  ****                         05160328
C                                                                       05170328
C     USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE OF THE  05180328
C     ACTUAL ARGUMENT ARRAY IS LARGER THAN THE SIZE OF THE ASSOCIATED   05190328
C     DUMMY ARGUMENT ARRAY.                                             05200328
C                                                                       05210328
      IVTNUM =  15                                                      05220328
      IF (ICZERO) 30150, 0150, 30150                                    05230328
 0150 CONTINUE                                                          05240328
      IVCOMP = 0                                                        05250328
      IACN11(1) = 1                                                     05260328
      IACN11(2) = 10                                                    05270328
      IACN11(3) = 100                                                   05280328
      IACN11(4) = 1000                                                  05290328
      IACN11(5) = 10000                                                 05300328
      CALL FS331(IACN11)                                                05310328
      IVCOMP = IVCN01                                                   05320328
      IVCORR = 1111                                                     05330328
40150 IF (IVCOMP - 1111) 20150, 10150, 20150                            05340328
30150 IVDELE = IVDELE + 1                                               05350328
      WRITE (I02,80000) IVTNUM                                          05360328
      IF (ICZERO) 10150, 0161, 20150                                    05370328
10150 IVPASS = IVPASS + 1                                               05380328
      WRITE (I02,80002) IVTNUM                                          05390328
      GO TO 0161                                                        05400328
20150 IVFAIL = IVFAIL + 1                                               05410328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          05420328
 0161 CONTINUE                                                          05430328
C                                                                       05440328
C     ****  FCVS PROGRAM 328  -  TEST 016  ****                         05450328
C                                                                       05460328
C     USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL       05470328
C     ARGUMENT ARRAY DECLARATOR IS LARGER AND HAS MORE SUBSCRIPT        05480328
C     EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR.  05490328
C                                                                       05500328
      IVTNUM =  16                                                      05510328
      IF (ICZERO) 30160, 0160, 30160                                    05520328
 0160 CONTINUE                                                          05530328
      IVCOMP = 0                                                        05540328
      IATN11(1,1) = 1                                                   05550328
      IATN11(2,1) = 10                                                  05560328
      IATN11(1,2) = 100                                                 05570328
      IATN11(2,2) = 1000                                                05580328
      IATN11(1,3) = 10000                                               05590328
      CALL FS331(IATN11)                                                05600328
      IVCOMP = IVCN01                                                   05610328
      IVCORR = 1111                                                     05620328
40160 IF (IVCOMP - 1111) 20160, 10160, 20160                            05630328
30160 IVDELE = IVDELE + 1                                               05640328
      WRITE (I02,80000) IVTNUM                                          05650328
      IF (ICZERO) 10160, 0171, 20160                                    05660328
10160 IVPASS = IVPASS + 1                                               05670328
      WRITE (I02,80002) IVTNUM                                          05680328
      GO TO 0171                                                        05690328
20160 IVFAIL = IVFAIL + 1                                               05700328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          05710328
 0171 CONTINUE                                                          05720328
C                                                                       05730328
C     ****  FCVS PROGRAM 328  -  TEST 017  ****                         05740328
C                                                                       05750328
C     USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE      05760328
C     ASSOCIATED ACTUAL AND DUMMY ARRAY DECLARATORS ARE IDENTICAL.  ALL 05770328
C     ARRAY ELEMENTS OF THE ACTUAL ARRAY SHOULD BE PASSED TO THE        05780328
C     DUMMY ARRAY OF THE SUBROUTINE.                                    05790328
C                                                                       05800328
      IVTNUM =  17                                                      05810328
      IF (ICZERO) 30170, 0170, 30170                                    05820328
 0170 CONTINUE                                                          05830328
      RVCOMP = 0.0                                                      05840328
      RADN12(1) = 1.                                                    05850328
      RADN12(2) = 10.                                                   05860328
      RADN12(3) = 100.                                                  05870328
      RADN12(4) = 1000.                                                 05880328
      CALL FS332(RADN12(1))                                             05890328
      RVCOMP = RVCN01                                                   05900328
      RVCORR = 1111.                                                    05910328
40170 IF (RVCOMP - 1110.5) 20170, 10170, 40171                          05920328
40171 IF (RVCOMP - 1111.5) 10170, 10170, 20170                          05930328
30170 IVDELE = IVDELE + 1                                               05940328
      WRITE (I02,80000) IVTNUM                                          05950328
      IF (ICZERO) 10170, 0181, 20170                                    05960328
10170 IVPASS = IVPASS + 1                                               05970328
      WRITE (I02,80002) IVTNUM                                          05980328
      GO TO 0181                                                        05990328
20170 IVFAIL = IVFAIL + 1                                               06000328
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          06010328
 0181 CONTINUE                                                          06020328
C                                                                       06030328
C     ****  FCVS PROGRAM 328  -  TEST 018  ****                         06040328
C                                                                       06050328
C     USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 06060328
C     OF THE ACTUAL ARGUMENT ARRAY IS LARGER AND HAS FEWER SUBSCRIPT    06070328
C     EXPRESSIONS THAN THE ASSOCIATED DUMMY ARRAY.  ONLY ACTUAL ARRAY   06080328
C     ELEMENTS WITH SUBSCRIPT VALUES OF 5, 6, 7 AND 8 ( OUT OF A        06090328
C     POSSIBLE 10 ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF      06100328
C     THE SUBROUTINE.                                                   06110328
C                                                                       06120328
      IVTNUM =  18                                                      06130328
      IF (ICZERO) 30180, 0180, 30180                                    06140328
 0180 CONTINUE                                                          06150328
      RVCOMP = 0.0                                                      06160328
      RACN11(4) = 1.                                                    06170328
      RACN11(5) = 10.                                                   06180328
      RACN11(6) = 100.                                                  06190328
      RACN11(7) = 1000.                                                 06200328
      RACN11(8) = 10000.                                                06210328
      RACN11(9) = 100000.                                               06220328
      CALL FS332(RACN11(5))                                             06230328
      RVCOMP = RVCN01                                                   06240328
      RVCORR =  11110.                                                  06250328
40180 IF (RVCOMP - 11105.) 20180, 10180, 40181                          06260328
40181 IF (RVCOMP - 11115.) 10180, 10180, 20180                          06270328
30180 IVDELE = IVDELE + 1                                               06280328
      WRITE (I02,80000) IVTNUM                                          06290328
      IF (ICZERO) 10180, 0191, 20180                                    06300328
10180 IVPASS = IVPASS + 1                                               06310328
      WRITE (I02,80002) IVTNUM                                          06320328
      GO TO 0191                                                        06330328
20180 IVFAIL = IVFAIL + 1                                               06340328
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          06350328
 0191 CONTINUE                                                          06360328
C                                                                       06370328
C     ****  FCVS PROGRAM 328  -  TEST 019  ****                         06380328
C                                                                       06390328
C     USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 06400328
C     OF THE ACTUAL ARGUMENT ARRAY IS LARGE THAN THE SIZE OF THE        06410328
C     ASSOCIATED DUMMY ARGUMENT ARRAY.  ONLY ACTUAL ARRAY ELEMENTS WITH 06420328
C     SUBSCRIPT VALUES OF 9, 10, 11 AND 12 (OUT OF A POSSIBLE 12        06430328
C     ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE SUBROUTINE.  06440328
C                                                                       06450328
      IVTNUM =  19                                                      06460328
      IF (ICZERO) 30190, 0190, 30190                                    06470328
 0190 CONTINUE                                                          06480328
      RVCOMP = 0.0                                                      06490328
      RATN11(2,3) = 1.                                                  06500328
      RATN11(3,3) = 10.                                                 06510328
      RATN11(1,4) = 100.                                                06520328
      RATN11(2,4) = 1000.                                               06530328
      RATN11(3,4) = 10000.                                              06540328
      CALL FS332(RATN11(3,3))                                           06550328
      RVCOMP = RVCN01                                                   06560328
      RVCORR = 11110.                                                   06570328
40190 IF (RVCOMP - 11105.) 20190, 10190, 40191                          06580328
40191 IF (RVCOMP - 11115.) 10190, 10190, 20190                          06590328
30190 IVDELE = IVDELE + 1                                               06600328
      WRITE (I02,80000) IVTNUM                                          06610328
      IF (ICZERO) 10190, 0201, 20190                                    06620328
10190 IVPASS = IVPASS + 1                                               06630328
      WRITE (I02,80002) IVTNUM                                          06640328
      GO TO 0201                                                        06650328
20190 IVFAIL = IVFAIL + 1                                               06660328
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          06670328
 0201 CONTINUE                                                          06680328
C                                                                       06690328
C     TEST 020 THROUGH TEST 022 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 06700328
C     OF ACTUAL ARGUMENTS TO PROCEDURES USED AS SUBROUTINE DUMMY        06710328
C     ARGUMENTS.  ACTUAL ARGUMENTS TESTED INCLUDE THE NAMES OF AN       06720328
C     EXTERNAL FUNCTION, AN INTRINSIC FUNCTION AND A SUBROUTINE.        06730328
C                                                                       06740328
C                                                                       06750328
C     ****  FCVS PROGRAM 328  -  TEST 020  ****                         06760328
C                                                                       06770328
C     USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT.              06780328
C                                                                       06790328
      IVTNUM =  20                                                      06800328
      IF (ICZERO) 30200, 0200, 30200                                    06810328
 0200 CONTINUE                                                          06820328
      IVCOMP = 0                                                        06830328
      CALL FS333(FF330, 5)                                              06840328
      IVCOMP = IVCN01                                                   06850328
      IVCORR = 7                                                        06860328
40200 IF (IVCOMP - 7) 20200, 10200, 20200                               06870328
30200 IVDELE = IVDELE + 1                                               06880328
      WRITE (I02,80000) IVTNUM                                          06890328
      IF (ICZERO) 10200, 0211, 20200                                    06900328
10200 IVPASS = IVPASS + 1                                               06910328
      WRITE (I02,80002) IVTNUM                                          06920328
      GO TO 0211                                                        06930328
20200 IVFAIL = IVFAIL + 1                                               06940328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          06950328
 0211 CONTINUE                                                          06960328
C                                                                       06970328
C     ****  FCVS PROGRAM 328  -  TEST 021  ****                         06980328
C                                                                       06990328
C     USE AN INTRINSIC FUNCTION NAME AS AN ACTUAL ARGUMENT.             07000328
C                                                                       07010328
      IVTNUM =  21                                                      07020328
      IF (ICZERO) 30210, 0210, 30210                                    07030328
 0210 CONTINUE                                                          07040328
      IVCOMP = 0                                                        07050328
      CALL FS333(IABS, -7)                                              07060328
      IVCOMP = IVCN01                                                   07070328
      IVCORR = 8                                                        07080328
40210 IF (IVCOMP - 8) 20210, 10210, 20210                               07090328
30210 IVDELE = IVDELE + 1                                               07100328
      WRITE (I02,80000) IVTNUM                                          07110328
      IF (ICZERO) 10210, 0221, 20210                                    07120328
10210 IVPASS = IVPASS + 1                                               07130328
      WRITE (I02,80002) IVTNUM                                          07140328
      GO TO 0221                                                        07150328
20210 IVFAIL = IVFAIL + 1                                               07160328
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          07170328
 0221 CONTINUE                                                          07180328
C                                                                       07190328
C     ****  FCVS PROGRAM 328  -  TEST 022  ****                         07200328
C                                                                       07210328
C     USE A SUBROUTINE NAME AS AN ACTUAL ARGUMENT.                      07220328
C                                                                       07230328
      IVTNUM =  22                                                      07240328
      IF (ICZERO) 30220, 0220, 30220                                    07250328
 0220 CONTINUE                                                          07260328
      RVCOMP = 0.0                                                      07270328
      RVON01 = 3.5                                                      07280328
      CALL FS334(FS335, RVON01)                                         07290328
      RVCOMP = RVCN01                                                   07300328
      RVCORR = 5.5                                                      07310328
40220 IF (RVCOMP - 5.4995) 20220, 10220, 40221                          07320328
40221 IF (RVCOMP - 5.5005) 10220, 10220, 20220                          07330328
30220 IVDELE = IVDELE + 1                                               07340328
      WRITE (I02,80000) IVTNUM                                          07350328
      IF (ICZERO) 10220, 0231, 20220                                    07360328
10220 IVPASS = IVPASS + 1                                               07370328
      WRITE (I02,80002) IVTNUM                                          07380328
      GO TO 0231                                                        07390328
20220 IVFAIL = IVFAIL + 1                                               07400328
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          07410328
 0231 CONTINUE                                                          07420328
C                                                                       07430328
C                                                                       07440328
C     WRITE OUT TEST SUMMARY                                            07450328
C                                                                       07460328
      WRITE (I02,90004)                                                 07470328
      WRITE (I02,90014)                                                 07480328
      WRITE (I02,90004)                                                 07490328
      WRITE (I02,90000)                                                 07500328
      WRITE (I02,90004)                                                 07510328
      WRITE (I02,90020) IVFAIL                                          07520328
      WRITE (I02,90022) IVPASS                                          07530328
      WRITE (I02,90024) IVDELE                                          07540328
      STOP                                                              07550328
90001 FORMAT (" ",24X,"FM328")                                          07560328
90000 FORMAT (" ",20X,"END OF PROGRAM FM328" )                          07570328
C                                                                       07580328
C     FORMATS FOR TEST DETAIL LINES                                     07590328
C                                                                       07600328
80000 FORMAT (" ",4X,I5,6X,"DELETED")                                   07610328
80002 FORMAT (" ",4X,I5,7X,"PASS")                                      07620328
80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6)                         07630328
80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5)                    07640328
80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14)                        07650328
C                                                                       07660328
C     FORMAT STATEMENTS FOR PAGE HEADERS                                07670328
C                                                                       07680328
90002 FORMAT ("1")                                                      07690328
90004 FORMAT (" ")                                                      07700328
90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" )            07710328
90008 FORMAT (" ",21X,"VERSION 2.1" )                                   07720328
90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" )         07730328
90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT")  07740328
90014 FORMAT (" ",5X,"----------------------------------------------" ) 07750328
90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" )                             07760328
C                                                                       07770328
C     FORMAT STATEMENTS FOR RUN SUMMARY                                 07780328
C                                                                       07790328
90020 FORMAT (" ",19X,I5," TESTS FAILED" )                              07800328
90022 FORMAT (" ",19X,I5," TESTS PASSED" )                              07810328
90024 FORMAT (" ",19X,I5," TESTS DELETED" )                             07820328
      END                                                               07830328

      SUBROUTINE FS329(IDON01, RDON01, LDON01)                          00010329
C          THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020329
C     FM328 TO TEST THE DIFFERENT FORMS OF INTEGER, REAL AND LOGICAL    00030329
C     ACTUAL ARGUMENTS THAT CAN BE ASSOCIATED WITH INTEGER, REAL AND    00040329
C     LOGICAL DUMMY ARGUMENTS.  THIS ROUTINE INCREMENTS THE INTEGER     00050329
C     AND REAL ARGUMENTS BY ONE AND NEGATES THE LOGICAL ARGUMENT.  ALL  00060329
C     RESULTS ARE THEN RETURNED TO FM328 VIA VARIABLES IN NAMED COMMON. 00070329
      IMPLICIT LOGICAL (L)                                              00080329
      COMMON /BLK1/ IVCN01, RVCN01, LVCN01                              00090329
      IVCN01 = IDON01 + 1                                               00100329
      RVCN01 = RDON01 + 1.0                                             00110329
      LVCN01 = .NOT. LDON01                                             00120329
      RETURN                                                            00130329
      END                                                               00140329

      INTEGER FUNCTION FF330(IDON02)                                    00010330
C         THIS FUNCTION IS USED BY TEST 011 OF THE MAIN PROGRAM FM328 TO00020330
C     TEST THE USE OF AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL       00030330
C     ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS A VARIABLE NAME.   00040330
C     THIS FUNCTION IS ALSO REFERENCED FROM SUBROUTINE FS333 VIA A      00050330
C     DUMMY PROCEDURE NAME REFERENCE.  THIS FUNCTION INCREMENTS THE     00060330
C     ARGUMENT VALUE BY ONE AND RETURNS THE RESULT AS THE FUNCTION      00070330
C     VALUE.                                                            00080330
      FF330 = IDON02 + 1                                                00090330
      RETURN                                                            00100330
      END                                                               00110330

      SUBROUTINE FS331(IDDN11)                                          00010331
C          THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020331
C     FM328 TO TEST THE USE OF AN ARRAY NAME AS AN ACTUAL ARGUMENT WHEN 00030331
C     THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME.  THIS ROUTINE     00040331
C     ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY ARGUMENT ARRAY AND   00050331
C     RETURNS THE RESULTS VIA A VARIABLE IN NAMED COMMON.               00060331
      LOGICAL LVCN01                                                    00070331
      DIMENSION IDDN11(4)                                               00080331
      COMMON /BLK1/IVCN01, RVCN01, LVCN01                               00090331
      IVCN01 = IDDN11(1) + IDDN11(2) + IDDN11(3) + IDDN11(4)            00100331
      RETURN                                                            00110331
      END                                                               00120331

      SUBROUTINE FS332(RDTN21)                                          00010332
C          THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020332
C     FM328 TO TEST THE USE OF AN ARRAY ELEMENT NAME AS AN ACTUAL       00030332
C     ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME.     00040332
C     THIS ROUTINE ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY         00050332
C     ARGUMENT ARRAY AND RETURNS THE RESULT VIA A VARIABLE IN NAMED     00060332
C     COMMON.                                                           00070332
      IMPLICIT LOGICAL (L)                                              00080332
      REAL RDTN21(2,2)                                                  00090332
      COMMON /BLK1/IVCN01, RVCN01, LVCN01                               00100332
      RVCN01 = RDTN21(1,1) + RDTN21(2,1) + RDTN21(1,2) + RDTN21(2,2)    00110332
      RETURN                                                            00120332
      END                                                               00130332

      SUBROUTINE FS333(NINT, IDON03)                                    00010333
C          THIS SUBROUTINE IS USED BY TESTS 020 AND 021 OF THE MAIN     00020333
C     PROGRAM FM328 TO TEST THE USE OF EXTERNAL AND INTRINSIC FUNCTION  00030333
C     NAMES AS ACTUAL ARGUMENTS WHEN THE ASSOCIATED DUMMY ARGUMENT IS A 00040333
C     PROCEDURE NAME.  THIS SUBROUTINE REFERENCES THE EXTERNAL FUNCTION 00050333
C     FF330 OR THE INTRINSIC FUNCTION IABS DEPENDING ON THE ACTUAL      00060333
C     ARGUMENT PASSED TO IT.  THE RESULT OF THIS FUNCTION REFERENCE IS  00070333
C     THEN INCREMENTED BY ONE AND THE RESULT IS RETURNED TO FS328 VIA   00080333
C     A VARIABLE IN NAMED COMMON.                                       00090333
      IMPLICIT LOGICAL (L)                                              00100333
      COMMON /BLK1/IVCN01, RVCN01, LVCN01                               00110333
      IVCN01 = NINT(IDON03) + 1                                         00120333
C              **** THE NAME NINT IS A DUMMY ARGUMENT NAME              00130333
C                     AND NOT AN INTRINSIC FUNCTION REFERENCE ****      00140333
      RETURN                                                            00150333
      END                                                               00160333

      SUBROUTINE FS334(IDON06, RDON03)                                  00010334
C          THIS SUBROUTINE IS USED BY TEST 022 OF THE MAIN PROGRAM      00020334
C     FM328 TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT  00030334
C     WHEN THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME.  THIS     00040334
C     SUBROUTINE CALLS THE SUBROUTINE FS335 VIA A DUMMY PROCEDURE NAME  00050334
C     REFERENCE.  THE ARGUMENT VALUE WHICH IS RETURNED FROM THE FS335   00060334
C     REFERENCE IS THEN INCREMENTED BY ONE AND RETURNED TO FM328 VIA    00070334
C     A VARIABLE IN NAMED COMMON.                                       00080334
      IMPLICIT LOGICAL (L)                                              00090334
      COMMON /BLK1/IVCN01, RVCN01, LVCN01                               00100334
      CALL IDON06(RDON03)                                               00110334
      RVCN01 = RDON03 + 1.0                                             00120334
      RETURN                                                            00130334
      END                                                               00140334

      SUBROUTINE FS335(RDON04)                                          00010335
C          THIS SUBROUITNE IS USED BY TEST 022 OF THE MAIN PROGRAM FM32800020335
C     TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT WHEN   00030335
C     THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME.  FS335 IS      00040335
C     CALLED FROM SUBROUTINE FS334 VIA A DUMMY PROCEDURE NAME REFERENCE.00050335
C     THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY ONE.                00060335
      RDON04 = RDON04 + 1.0                                             00070335
      RETURN                                                            00080335
      END                                                               00090335