blob: f2923c3fa8df1ca56ec6d7181f4ea49eb3596fb2 [file] [log] [blame]
PROGRAM FM302 00010302
C 00020302
C 00030302
C THIS ROUTINE TESTS THE SUBSET LEVEL FEATURES OF THE COMMON 00040302
C SPECIFICATION STATEMENT. INTEGER, REAL AND LOGICAL VARIABLES AND 00050302
C ARRAYS ARE PASSED BACK-AND-FORTH BETWEEN THE MAIN PROGRAM,EXTERNAL00060302
C FUNCTIONS AND SUBROUTINES. BOTH NAMED AND UNNAMED (BLANK) COMMON 00070302
C ARE TESTED. SPECIFIC TESTS ARE INCLUDED FOR RENAMING ENTITIES IN 00080302
C COMMON BETWEEN PROGRAM UNITS, THE PASSING OF DATA THROUGH COMMON 00090302
C BY EQUIVALENCE ASSOCIATION, AND THE SPECIFYING OF BLANK COMMON OF 00100302
C DIFFERENT LENGTHS IN DIFFERENT PROGRAM UNITS. THE SUBSET LEVEL 00110302
C FEATURES OF THE COMMON STATEMENT ARE ALSO TESTED IN FM022 THROUGH 00120302
C FM025, FM050 AND FM056. 00130302
C 00140302
C REFERENCES. 00150302
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160302
C X3.9-1978 00170302
C 00180302
C SECTION 8.2, EQUIVALENCE STATEMENT 00190302
C SECTION 8.3, COMMON STATEMENT 00200302
C SECTION 15.5, EXTERNAL FUNCTIONS 00210302
C SECTION 15.6, SUBROUTINES 00220302
C SECTION 15.9.4, COMMON BLOCKS 00230302
C 00240302
C 00250302
C ******************************************************************00260302
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00270302
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00280302
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00290302
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00300302
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00310302
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00320302
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00330302
C THE RESULT OF EXECUTING THESE TESTS. 00340302
C 00350302
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00360302
C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00370302
C 00380302
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00390302
C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00400302
C SOFTWARE STANDARDS VALIDATION GROUP 00410302
C BUILDING 225 RM A266 00420302
C GAITHERSBURG, MD 20899 00430302
C ******************************************************************00440302
C 00450302
C 00460302
IMPLICIT LOGICAL (L) 00470302
IMPLICIT CHARACTER*14 (C) 00480302
C 00490302
00500302
C 00510302
C *** SPECIFICATION STATEMENT FOR TEST 001 *** 00520302
C 00530302
COMMON IVCN01 00540302
C 00550302
C *** SPECIFICATION STATEMENT FOR TEST 002 *** 00560302
C 00570302
COMMON //IVCN02,LVCN01 00580302
C 00590302
C *** SPECIFICATION STATEMENT FOR TEST 003 *** 00600302
C 00610302
COMMON RVCN01//IVCN03 00620302
C 00630302
C *** SPECIFICATION STATEMENT FOR TEST 004 *** 00640302
C 00650302
COMMON IVCN04, IVCN05, // IACN11(4) 00660302
C 00670302
C *** SPECIFICATION STATEMENT FOR TEST 005 *** 00680302
C 00690302
COMMON /BLK1/ IVCNA1 00700302
C 00710302
C *** SPECIFICATION STATEMENT FOR TEST 006 *** 00720302
C 00730302
COMMON /BLK2/IVCNB1,RVCNB1, /BLK2/IVCNB2 00740302
C 00750302
C *** SPECIFICATION STATEMENT FOR TEST 007 *** 00760302
C 00770302
DIMENSION RACN11(10) 00780302
COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3) 00790302
C 00800302
C *** SPECIFICATION STATEMENT FOR TEST 008 *** 00810302
C 00820302
COMMON /BLK5/IVCND1, IVCND2 00830302
C 00840302
C *** SPECIFICATION STATEMENT FOR TEST 009 *** 00850302
C 00860302
COMMON IVCN06/BLK5/RVCND1,LVCND1//IVCN07,IVCN08/BLK6/RVCNE1 00870302
C 00880302
C *** SPECIFICATION STATEMENT FOR TEST 010 *** 00890302
C 00900302
DIMENSION IACN1F(3) 00910302
COMMON /BLK7/IVCNF1,IVCNF2,IVCNF3,IACN1F 00920302
C 00930302
C *** SPECIFICATION STATEMENT FOR TEST 011 *** 00940302
C 00950302
EQUIVALENCE (IVCEH1,IVCEH2) 00960302
COMMON /BLK8/IVCEH1 00970302
C 00980302
C *** SPECIFICATION STATEMENT FOR TEST 012 00990302
EQUIVALENCE (IVCE09,IVCE10) 01000302
COMMON IVCE09 01010302
C 01020302
C *** SPECIFICATION STATEMENT FOR TEST 013 01030302
C 01040302
EQUIVALENCE (IVCEI1,IACE1I) 01050302
DIMENSION IACE1I(3) 01060302
COMMON /BLK9/IVCEI1 01070302
C 01080302
C *** SPECIFICATION STATEMENT FOR TEST 014 *** 01090302
C 01100302
COMMON IVCN12 01110302
C 01120302
C *** SPECIFICATION STATEMENT FOR TEST 015 *** 01130302
C 01140302
COMMON /BLK10/IVCNJ1 01150302
C 01160302
C *** SPECIFICATION STATEMENT FOR TEST 016 *** 01170302
C 01180302
COMMON /BLKCHR/CVTN01,CVTN02,CATN11 01190302
CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5 01200302
INTEGER FF304 01210302
C 01220302
C 01230302
C 01240302
C INITIALIZATION SECTION. 01250302
C 01260302
C INITIALIZE CONSTANTS 01270302
C ******************** 01280302
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01290302
I01 = 5 01300302
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01310302
I02 = 6 01320302
C SYSTEM ENVIRONMENT SECTION 01330302
C 01340302
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01350302
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01360302
C (UNIT NUMBER FOR CARD READER). 01370302
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01380302
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01390302
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01400302
C 01410302
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01420302
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01430302
C (UNIT NUMBER FOR PRINTER). 01440302
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01450302
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01460302
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01470302
C 01480302
IVPASS = 0 01490302
IVFAIL = 0 01500302
IVDELE = 0 01510302
ICZERO = 0 01520302
C 01530302
C WRITE OUT PAGE HEADERS 01540302
C 01550302
WRITE (I02,90002) 01560302
WRITE (I02,90006) 01570302
WRITE (I02,90008) 01580302
WRITE (I02,90004) 01590302
WRITE (I02,90010) 01600302
WRITE (I02,90004) 01610302
WRITE (I02,90016) 01620302
WRITE (I02,90001) 01630302
WRITE (I02,90004) 01640302
WRITE (I02,90012) 01650302
WRITE (I02,90014) 01660302
WRITE (I02,90004) 01670302
C 01680302
C 01690302
C THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA 01700302
C ENTITIES BEING PASSED THROUGH COMMON TO SUBROUTINE FS303. ONLY 01710302
C ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM. THE 01720302
C CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON ARE 01730302
C THEN CHECKED IN THIS PROGRAM. 01740302
C 01750302
C 01760302
IVCN01 = 3 01770302
IVCN02 = 2 01780302
LVCN01 = .FALSE. 01790302
IVCNA1 = 25 01800302
IVCNB1 = 3 01810302
RVCNB1 = 4.0 01820302
IVCNB2 = 5 01830302
LVCNC1 = .TRUE. 01840302
IVCNC1 = 13 01850302
RACN11(1) = 1. 01860302
RACN11(10) = 10.0 01870302
IACN21(1,1) = 11 01880302
IACN21(2,3) = 23 01890302
IVCNF1 = 41 01900302
IVCNF3 = 43 01910302
IACN1F(1) = 141 01920302
IACN1F(2) = 142 01930302
IVCEH1 = 1 01940302
IVCEH2 = 5 01950302
CVTN01 = 'AB' 01960302
CVTN02 = 'CDE' 01970302
CATN11(1) = 'FGHIJ' 01980302
CATN11(2) = 'KLMNO' 01990302
CATN11(3) = 'PQRST' 02000302
CALL FS303 02010302
C 02020302
C THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA 02030302
C ENTITIES BEING PASSED THROUGH COMMON TO EXTERNAL FUNCTION FF304. 02040302
C ONLY ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM. 02050302
C THE CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON 02060302
C ARE THEN CHECKED IN THIS PROGRAM. 02070302
C 02080302
RVCN01 = 6.4 02090302
IVCN03 = 11 02100302
IVCN03 = IVCN03*2 02110302
IVCN04 = 16 02120302
IVCN05 = 16 02130302
IACN11(1) = 1 02140302
IACN11(2) = 2 02150302
IACN11(3) = 3 02160302
IACN11(4) = 4 02170302
IVCND1 = +33 02180302
IVCND2 = 10 02190302
IVCN06 = 6 02200302
IVCN07 = 7 02210302
IVCN08 = 8 02220302
RVCND1 = 1.3 02230302
LVCND1 = .FALSE. 02240302
RVCNE1 = +3.5 02250302
IVCE09 = 9 02260302
IVCE10 = 10 02270302
IVCEI1 = 5 02280302
IACE1I(1) = 10 02290302
IACE1I(2) = 15 02300302
IACE1I(3) = 20 02310302
IVCNJ1 = 1 02320302
IVON99 = FF304 ( ) 02330302
C 02340302
C TESTS 001 THROUGH 009 ARE DESIGNED TO TEST VARIOUS 02350302
C SYNTACTICAL CONSTRUCTS OF THE COMMON STATEMENT USING NAMED AND 02360302
C UNNAMED (BLANK) COMMON IN THE MAIN PROGRAM, A SUBROUTINE AND AN 02370302
C EXTERNAL FUNCTION. DATA ENTITIES CONSIST OF INTEGER, REAL AND 02380302
C LOGICAL VARIABLES AND INTEGER AND REAL ARRAYS. 02390302
C 02400302
C **** FCVS PROGRAM 302 - TEST 001 **** 02410302
C 02420302
C TESTS 001 AND 002 TEST THE USE OF UNNAMED COMMON IN A MAIN 02430302
C PROGRAM AND A SUBROUTINE. 02440302
C 02450302
IVTNUM = 1 02460302
IF (ICZERO) 30010, 0010, 30010 02470302
0010 CONTINUE 02480302
IVCOMP = 0 02490302
IVCOMP = IVCN01 02500302
IVCORR = 4 02510302
40010 IF (IVCOMP - 4) 20010, 10010, 20010 02520302
30010 IVDELE = IVDELE + 1 02530302
WRITE (I02,80000) IVTNUM 02540302
IF (ICZERO) 10010, 0021, 20010 02550302
10010 IVPASS = IVPASS + 1 02560302
WRITE (I02,80002) IVTNUM 02570302
GO TO 0021 02580302
20010 IVFAIL = IVFAIL + 1 02590302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02600302
0021 CONTINUE 02610302
C 02620302
C **** FCVS PROGRAM 302 - TEST 002 **** 02630302
C 02640302
C 02650302
IVTNUM = 2 02660302
IF (ICZERO) 30020, 0020, 30020 02670302
0020 CONTINUE 02680302
IVCOMP = 1 02690302
IF (IVCN02 .EQ. 7) IVCOMP = IVCOMP * 2 02700302
IF (LVCN01) IVCOMP = IVCOMP * 3 02710302
IVCORR = 6 02720302
C 6 = 2 * 3 02730302
40020 IF (IVCOMP - 6) 20020, 10020, 20020 02740302
30020 IVDELE = IVDELE + 1 02750302
WRITE (I02,80000) IVTNUM 02760302
IF (ICZERO) 10020, 0031, 20020 02770302
10020 IVPASS = IVPASS + 1 02780302
WRITE (I02,80002) IVTNUM 02790302
GO TO 0031 02800302
20020 IVFAIL = IVFAIL + 1 02810302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02820302
0031 CONTINUE 02830302
C 02840302
C **** FCVS PROGRAM 302 - TEST 003 **** 02850302
C 02860302
C TESTS 003 AND 004 TEST THE USE OF UNNAMED COMMON IN A MAIN 02870302
C PROGRAM AND AN EXTERNAL FUNCTION. 02880302
C 02890302
IVTNUM = 3 02900302
IF (ICZERO) 30030, 0030, 30030 02910302
0030 CONTINUE 02920302
IVCOMP = 1 02930302
IF (RVCN01 .GE. 4.1995 .AND. RVCN01 .LE. 4.2005) IVCOMP=IVCOMP*2 02940302
IF (IVCN03 .EQ. 23) IVCOMP = IVCOMP * 3 02950302
IVCORR = 6 02960302
C 6 = 2 * 3 02970302
40030 IF (IVCOMP - 6) 20030, 10030, 20030 02980302
30030 IVDELE = IVDELE + 1 02990302
WRITE (I02,80000) IVTNUM 03000302
IF (ICZERO) 10030, 0041, 20030 03010302
10030 IVPASS = IVPASS + 1 03020302
WRITE (I02,80002) IVTNUM 03030302
GO TO 0041 03040302
20030 IVFAIL = IVFAIL + 1 03050302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03060302
0041 CONTINUE 03070302
C 03080302
C **** FCVS PROGRAM 302 - TEST 004 **** 03090302
C 03100302
C 03110302
IVTNUM = 4 03120302
IF (ICZERO) 30040, 0040, 30040 03130302
0040 CONTINUE 03140302
IVCOMP = 1 03150302
IF (IVCN04 .EQ. 8) IVCOMP = IVCOMP * 2 03160302
IF (IVCN05 .EQ. 16) IVCOMP = IVCOMP * 3 03170302
IF (IACN11(1) .EQ. 5) IVCOMP = IVCOMP * 5 03180302
IF (IACN11(2) .EQ. 5) IVCOMP = IVCOMP * 7 03190302
IF (IACN11(3) .EQ. 5) IVCOMP = IVCOMP * 11 03200302
IF (IACN11(4) .EQ. 5) IVCOMP = IVCOMP * 13 03210302
IVCORR = 30030 03220302
C 30030 = 2 * 3 * 5 * 7 * 11 * 13 03230302
40040 IF (IVCOMP - 30030) 20040, 10040, 20040 03240302
30040 IVDELE = IVDELE + 1 03250302
WRITE (I02,80000) IVTNUM 03260302
IF (ICZERO) 10040, 0051, 20040 03270302
10040 IVPASS = IVPASS + 1 03280302
WRITE (I02,80002) IVTNUM 03290302
GO TO 0051 03300302
20040 IVFAIL = IVFAIL + 1 03310302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03320302
0051 CONTINUE 03330302
C 03340302
C **** FCVS PROGRAM 302 - TEST 005 **** 03350302
C 03360302
C TESTS 005 THROUGH 007 TEST THE USE OF NAMED COMMON BLOCKS 03370302
C IN A MAIN PROGRAM AND A SUBROUTINE. 03380302
C 03390302
IVTNUM = 5 03400302
IF (ICZERO) 30050, 0050, 30050 03410302
0050 CONTINUE 03420302
IVCOMP = 0 03430302
IVCOMP = IVCNA1 03440302
IVCORR = 5 03450302
40050 IF (IVCOMP - 5) 20050, 10050, 20050 03460302
30050 IVDELE = IVDELE + 1 03470302
WRITE (I02,80000) IVTNUM 03480302
IF (ICZERO) 10050, 0061, 20050 03490302
10050 IVPASS = IVPASS + 1 03500302
WRITE (I02,80002) IVTNUM 03510302
GO TO 0061 03520302
20050 IVFAIL = IVFAIL + 1 03530302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03540302
0061 CONTINUE 03550302
C 03560302
C **** FCVS PROGRAM 302 - TEST 006 **** 03570302
C 03580302
C 03590302
IVTNUM = 6 03600302
IF (ICZERO) 30060, 0060, 30060 03610302
0060 CONTINUE 03620302
IVCOMP = 1 03630302
IF (IVCNB1 .EQ. 8) IVCOMP = IVCOMP * 2 03640302
IF (RVCNB1 .GE. 3.4995 .AND. RVCNB1 .LE. 3.5005) IVCOMP=IVCOMP*3 03650302
IF (IVCNB2 .EQ. 5) IVCOMP = IVCOMP * 5 03660302
IVCORR = 30 03670302
C 30 = 2 * 3 * 5 03680302
40060 IF (IVCOMP - 30) 20060, 10060, 20060 03690302
30060 IVDELE = IVDELE + 1 03700302
WRITE (I02,80000) IVTNUM 03710302
IF (ICZERO) 10060, 0071, 20060 03720302
10060 IVPASS = IVPASS + 1 03730302
WRITE (I02,80002) IVTNUM 03740302
GO TO 0071 03750302
20060 IVFAIL = IVFAIL + 1 03760302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03770302
0071 CONTINUE 03780302
C 03790302
C **** FCVS PROGRAM 302 - TEST 007 **** 03800302
C 03810302
C 03820302
IVTNUM = 7 03830302
IF (ICZERO) 30070, 0070, 30070 03840302
0070 CONTINUE 03850302
IVCOMP = 1 03860302
IF (.NOT. LVCNC1) IVCOMP = IVCOMP * 2 03870302
IF (IVCNC1 .EQ. 12) IVCOMP = IVCOMP * 3 03880302
IF (RACN11(1).GE.110.95 .AND. RACN11(1).LE.111.05) IVCOMP=IVCOMP*503890302
IF (RACN11(10).GE.109.95.AND.RACN11(10).LE.110.05)IVCOMP=IVCOMP*7 03900302
IF (IACN21(1,1) .EQ. 12) IVCOMP = IVCOMP * 11 03910302
IF (IACN21 (2,3) .EQ. 24) IVCOMP = IVCOMP * 13 03920302
IVCORR = 30030 03930302
C 30030 = 2* 3 * 5 * 7 * 11 * 13 03940302
40070 IF (IVCOMP - 30030) 20070, 10070, 20070 03950302
30070 IVDELE = IVDELE + 1 03960302
WRITE (I02,80000) IVTNUM 03970302
IF (ICZERO) 10070, 0081, 20070 03980302
10070 IVPASS = IVPASS + 1 03990302
WRITE (I02,80002) IVTNUM 04000302
GO TO 0081 04010302
20070 IVFAIL = IVFAIL + 1 04020302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04030302
0081 CONTINUE 04040302
C 04050302
C **** FCVS PROGRAM 302 - TEST 008 **** 04060302
C 04070302
C TESTS 008 AND 009 TEST THE USE OF NAMED COMMON BLOCKS IN A 04080302
C MAIN PROGRAM AND AN EXTERNAL FUNCTION. 04090302
C 04100302
IVTNUM = 8 04110302
IF (ICZERO) 30080, 0080, 30080 04120302
0080 CONTINUE 04130302
IVCOMP = 1 04140302
IF (IVCND1 .EQ. 34) IVCOMP = IVCOMP * 2 04150302
IF (IVCND2 .EQ. 11) IVCOMP = IVCOMP * 3 04160302
IVCORR = 6 04170302
C 6 = 2 * 3 04180302
40080 IF (IVCOMP - 6) 20080, 10080, 20080 04190302
30080 IVDELE = IVDELE + 1 04200302
WRITE (I02,80000) IVTNUM 04210302
IF (ICZERO) 10080, 0091, 20080 04220302
10080 IVPASS = IVPASS + 1 04230302
WRITE (I02,80002) IVTNUM 04240302
GO TO 0091 04250302
20080 IVFAIL = IVFAIL + 1 04260302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04270302
0091 CONTINUE 04280302
C 04290302
C **** FCVS PROGRAM 302 - TEST 009 **** 04300302
C 04310302
C 04320302
IVTNUM = 9 04330302
IF (ICZERO) 30090, 0090, 30090 04340302
0090 CONTINUE 04350302
IVCOMP = 1 04360302
IF (IVCN06 .EQ. 7) IVCOMP = IVCOMP * 2 04370302
IF (RVCND1 .GE. 4.4995 .AND. RVCND1 .LE. 4.5005) IVCOMP = IVCOMP*304380302
IF (LVCND1) IVCOMP = IVCOMP * 5 04390302
IF (IVCN07 .EQ. -7) IVCOMP = IVCOMP * 7 04400302
IF (IVCN08 .EQ. -3) IVCOMP = IVCOMP * 11 04410302
IF (RVCNE1.GE.-6.7005.AND.RVCNE1.LE.-6.6995) IVCOMP=IVCOMP*13 04420302
IVCORR = 30030 04430302
C 30030 = 2 * 3 * 5 * 7 * 11 * 13 04440302
40090 IF (IVCOMP - 30030) 20090, 10090, 20090 04450302
30090 IVDELE = IVDELE + 1 04460302
WRITE (I02,80000) IVTNUM 04470302
IF (ICZERO) 10090, 0101, 20090 04480302
10090 IVPASS = IVPASS + 1 04490302
WRITE (I02,80002) IVTNUM 04500302
GO TO 0101 04510302
20090 IVFAIL = IVFAIL + 1 04520302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04530302
0101 CONTINUE 04540302
C 04550302
C **** FCVS PROGRAM 302 - TEST 010 **** 04560302
C 04570302
C TEST 010 IS DESIGNED TO TEST THE ABILITY TO RENAME ENTITIES 04580302
C IN NAMED COMMON BETWEEN A MAIN PROGRAM AND A SUBROUTINE. 04590302
C 04600302
IVTNUM = 10 04610302
IF (ICZERO) 30100, 0100, 30100 04620302
0100 CONTINUE 04630302
IVCOMP = 1 04640302
IF (IVCNF1 .EQ. 42) IVCOMP = IVCOMP * 2 04650302
IF (IVCNF2 .EQ. 43) IVCOMP = IVCOMP * 3 04660302
IF (IVCNF3 .EQ. 44) IVCOMP = IVCOMP * 5 04670302
IF (IACN1F(1) .EQ. 142) IVCOMP = IVCOMP * 7 04680302
IF (IACN1F(2) .EQ. 143) IVCOMP = IVCOMP * 11 04690302
IF (IACN1F(3) .EQ. 144) IVCOMP = IVCOMP * 13 04700302
IVCORR = 30030 04710302
C 30030 = 2 * 3 * 5 * 7 * 11 * 13 04720302
40100 IF (IVCOMP - 30030) 20100, 10100, 20100 04730302
30100 IVDELE = IVDELE + 1 04740302
WRITE (I02,80000) IVTNUM 04750302
IF (ICZERO) 10100, 0111, 20100 04760302
10100 IVPASS = IVPASS + 1 04770302
WRITE (I02,80002) IVTNUM 04780302
GO TO 0111 04790302
20100 IVFAIL = IVFAIL + 1 04800302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04810302
0111 CONTINUE 04820302
C 04830302
C **** FCVS PROGRAM 302 - TEST 011 **** 04840302
C 04850302
C TEST 011 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE IN 04860302
C NAMED COMMON BY EQUIVALENCE ASSOCIATION. 04870302
C 04880302
IVTNUM = 11 04890302
IF (ICZERO) 30110, 0110, 30110 04900302
0110 CONTINUE 04910302
IVCOMP = 0 04920302
IVCOMP = IVCEH2 04930302
IVCORR = 6 04940302
40110 IF (IVCOMP - 6) 20110, 10110, 20110 04950302
30110 IVDELE = IVDELE + 1 04960302
WRITE (I02,80000) IVTNUM 04970302
IF (ICZERO) 10110, 0121, 20110 04980302
10110 IVPASS = IVPASS + 1 04990302
WRITE (I02,80002) IVTNUM 05000302
GO TO 0121 05010302
20110 IVFAIL = IVFAIL + 1 05020302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05030302
0121 CONTINUE 05040302
C 05050302
C **** FCVS PROGRAM 302 - TEST 012 **** 05060302
C 05070302
C TEST 012 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE IN 05080302
C UNNAMED COMMON BY EQUIVALENCE ASSOCIATION. 05090302
C 05100302
IVTNUM = 12 05110302
IF (ICZERO) 30120, 0120, 30120 05120302
0120 CONTINUE 05130302
IVCOMP = 1 05140302
IF (IVCE09 .EQ. 100) IVCOMP = IVCOMP * 2 05150302
IF (IVCE10 .EQ. 100) IVCOMP = IVCOMP * 3 05160302
IVCORR = 6 05170302
C 6 = 2 * 3 05180302
40120 IF (IVCOMP - 6) 20120, 10120, 20120 05190302
30120 IVDELE = IVDELE + 1 05200302
WRITE (I02,80000) IVTNUM 05210302
IF (ICZERO) 10120, 0131, 20120 05220302
10120 IVPASS = IVPASS + 1 05230302
WRITE (I02,80002) IVTNUM 05240302
GO TO 0131 05250302
20120 IVFAIL = IVFAIL + 1 05260302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05270302
0131 CONTINUE 05280302
C 05290302
C **** FCVS PROGRAM 302 - TEST 013 **** 05300302
C 05310302
C TEST 013 IS DESIGNED TO TEST THE EXTENSION OF NAMED COMMON 05320302
C BLOCK STORAGE BY EQUIVALENCE ASSOCIATION OF A VARIABLE AND AN 05330302
C ARRAY. 05340302
C 05350302
IVTNUM = 13 05360302
IF (ICZERO) 30130, 0130, 30130 05370302
0130 CONTINUE 05380302
IVCOMP = 1 05390302
IF (IVCEI1 .EQ. 11) IVCOMP = IVCOMP * 2 05400302
IF (IACE1I(1) .EQ. 11) IVCOMP = IVCOMP * 3 05410302
IF (IACE1I(2) .EQ. 16) IVCOMP = IVCOMP * 5 05420302
IF (IACE1I(3) .EQ. 21) IVCOMP = IVCOMP * 7 05430302
IVCORR = 210 05440302
C 210 = 2 * 3 * 5 * 7 05450302
40130 IF (IVCOMP - 210) 20130, 10130, 20130 05460302
30130 IVDELE = IVDELE + 1 05470302
WRITE (I02,80000) IVTNUM 05480302
IF (ICZERO) 10130, 0141, 20130 05490302
10130 IVPASS = IVPASS + 1 05500302
WRITE (I02,80002) IVTNUM 05510302
GO TO 0141 05520302
20130 IVFAIL = IVFAIL + 1 05530302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05540302
0141 CONTINUE 05550302
C 05560302
C **** FCVS PROGRAM 302 - TEST 014 **** 05570302
C 05580302
C TEST 014 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA 05590302
C THROUGH UNNAMED COMMON FROM EXTERNAL FUNCTIONS WHICH HAVE MORE 05600302
C ENTITIES IN UNNAMED COMMON THAN THE MAIN PROGRAM. 05610302
C 05620302
IVTNUM = 14 05630302
IF (ICZERO) 30140, 0140, 30140 05640302
0140 CONTINUE 05650302
IVCOMP = 0 05660302
IVCOMP = IVCN12 05670302
IVCORR = 11 05680302
40140 IF (IVCOMP - 11) 20140, 10140, 20140 05690302
30140 IVDELE = IVDELE + 1 05700302
WRITE (I02,80000) IVTNUM 05710302
IF (ICZERO) 10140, 0151, 20140 05720302
10140 IVPASS = IVPASS + 1 05730302
WRITE (I02,80002) IVTNUM 05740302
GO TO 0151 05750302
20140 IVFAIL = IVFAIL + 1 05760302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05770302
0151 CONTINUE 05780302
C 05790302
C **** FCVS PROGRAM 302 - TEST 015 **** 05800302
C 05810302
C TEST 015 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA 05820302
C THROUGH NAMED COMMON BETWEEN EXTERNAL FUNCTIONS WHERE THE NAMED 05830302
C COMMON BLOCK IS NOT SPECIFIED IN THE MAIN PROGRAM. 05840302
C 05850302
IVTNUM = 15 05860302
IF (ICZERO) 30150, 0150, 30150 05870302
0150 CONTINUE 05880302
IVCOMP = 0 05890302
IVCOMP = IVCNJ1 05900302
IVCORR = 5 05910302
40150 IF (IVCOMP - 5) 20150, 10150, 20150 05920302
30150 IVDELE = IVDELE + 1 05930302
WRITE (I02,80000) IVTNUM 05940302
IF (ICZERO) 10150, 0161, 20150 05950302
10150 IVPASS = IVPASS + 1 05960302
WRITE (I02,80002) IVTNUM 05970302
GO TO 0161 05980302
20150 IVFAIL = IVFAIL + 1 05990302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06000302
0161 CONTINUE 06010302
C 06020302
C **** FCVS PROGRAM 302 - TEST 016 **** 06030302
C 06040302
C TEST 016 IS DESIGNED TO TEST THE PASSING OF CHARACTER DATA 06050302
C IN NAMED COMMON BETWEEN THE MAIN PROGRAM AND A SUBROUTINE. 06060302
C 06070302
IVTNUM = 16 06080302
IF (ICZERO) 30160, 0160, 30160 06090302
0160 CONTINUE 06100302
IVCOMP = 1 06110302
IF (CVTN01 .EQ. 'YZ') IVCOMP = IVCOMP * 2 06120302
IF (CVTN02 .EQ. 'UVW') IVCOMP = IVCOMP * 3 06130302
IF (CATN11(1) .EQ. 'VWXYZ') IVCOMP = IVCOMP * 5 06140302
IF (CATN11(2) .EQ. 'KLMNO') IVCOMP = IVCOMP * 7 06150302
IF (CATN11(3) .EQ. 'ABCDE') IVCOMP = IVCOMP * 11 06160302
IVCORR = 2310 06170302
C 2310 = 2 * 3 * 5 * 7 * 11 06180302
40160 IF (IVCOMP - 2310) 20160, 10160, 20160 06190302
30160 IVDELE = IVDELE + 1 06200302
WRITE (I02,80000) IVTNUM 06210302
IF (ICZERO) 10160, 0171, 20160 06220302
10160 IVPASS = IVPASS + 1 06230302
WRITE (I02,80002) IVTNUM 06240302
GO TO 0171 06250302
20160 IVFAIL = IVFAIL + 1 06260302
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06270302
0171 CONTINUE 06280302
C 06290302
C 06300302
C WRITE OUT TEST SUMMARY 06310302
C 06320302
WRITE (I02,90004) 06330302
WRITE (I02,90014) 06340302
WRITE (I02,90004) 06350302
WRITE (I02,90000) 06360302
WRITE (I02,90004) 06370302
WRITE (I02,90020) IVFAIL 06380302
WRITE (I02,90022) IVPASS 06390302
WRITE (I02,90024) IVDELE 06400302
STOP 06410302
90001 FORMAT (" ",24X,"FM302") 06420302
90000 FORMAT (" ",20X,"END OF PROGRAM FM302" ) 06430302
C 06440302
C FORMATS FOR TEST DETAIL LINES 06450302
C 06460302
80000 FORMAT (" ",4X,I5,6X,"DELETED") 06470302
80002 FORMAT (" ",4X,I5,7X,"PASS") 06480302
80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 06490302
80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 06500302
80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 06510302
C 06520302
C FORMAT STATEMENTS FOR PAGE HEADERS 06530302
C 06540302
90002 FORMAT ("1") 06550302
90004 FORMAT (" ") 06560302
90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06570302
90008 FORMAT (" ",21X,"VERSION 2.1" ) 06580302
90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 06590302
90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 06600302
90014 FORMAT (" ",5X,"----------------------------------------------" ) 06610302
90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 06620302
C 06630302
C FORMAT STATEMENTS FOR RUN SUMMARY 06640302
C 06650302
90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 06660302
90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 06670302
90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 06680302
END 06690302
SUBROUTINE FS303 00010303
C 00020303
C FS303 IS A SUBROUTINE WHICH IS CALLED ONCE FROM PROGRAM FM302. 00030303
C IT IS USED TO MODIFY VARIABLES AND ARRAY PASSED THROUGH NAMED AND 00040303
C UNNAMED COMMON FROM FM302. AFTER THE DATA ENTITIES ARE MODIFIED 00050303
C CONTROL IS RETURNED TO FM302 WHERE EACH ENTITY IS TESTED. 00060303
C 00070303
IMPLICIT LOGICAL (L) 00080303
DIMENSION RACN11(10) 00090303
COMMON IVCN01 00100303
COMMON //IVCN02, LVCN01 00110303
COMMON RVCN01//IVCN03 00120303
COMMON IVCN04,IVCN05, //IACN11(4) 00130303
COMMON /BLK1/IVCNA1 00140303
COMMON /BLK2/IVCNB1,RVCNB1,/BLK2/IVCNB2 00150303
COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3) 00160303
COMMON /BLK7/IACN1G(5),IVCNG1 00170303
COMMON /BLK8/IVCNH1 00180303
COMMON /BLKCHR/CVTN01,CVTN02,CATN11 00190303
CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5 00200303
C TEST 001 00210303
IVCN01 = IVCN01 + 1 00220303
C TEST 002 00230303
IVCN02 = IVCN02 + 5 00240303
LVCN01 = .NOT. LVCN01 00250303
C TEST 005 00260303
IVCNA1 = IVCNA1 / 5 00270303
C TEST 006 00280303
IVCNB1 = IVCNB1 + IVCNB2 00290303
RVCNB1 = 3.5 00300303
C TEST 007 00310303
LVCNC1 = .FALSE. 00320303
IVCNC1 = IVCNC1 - 1 00330303
RACN11(1) = 111. 00340303
RACN11(10) = 110. 00350303
IACN21(1,1) = IACN21(1,1) + 1 00360303
IACN21(2,3) = IACN21(2,3) + 1 00370303
C TEST 010 00380303
IACN1G(1) = IACN1G(1) + 1 00390303
IACN1G(2) = 43 00400303
IACN1G(3) = IACN1G(3) + 1 00410303
IACN1G(4) = IACN1G(4) + 1 00420303
IACN1G(5) = IACN1G(5) + 1 00430303
IVCNG1 = 144 00440303
C TEST 011 00450303
IVCNH1 = IVCNH1 + 1 00460303
C TEST 017 00470303
CVTN01 = 'YZ' 00480303
CVTN02 = 'UVW' 00490303
CATN11(1) = 'VWXYZ' 00500303
CATN11(3) = 'ABCDE' 00510303
RETURN 00520303
END 00530303
INTEGER FUNCTION FF304 () 00010304
C 00020304
C FF304 IS AN EXTERNAL FUNCTION WHICH IS REFERENCED ONCE FROM 00030304
C PROGRAM FM302. IT IS USED TO MODIFY VARIABLES AND ARRAYS PASSED 00040304
C THROUGH NAMED AND UNNAMED COMMON FROM FM302. AFTER THE DATA 00050304
C ENTITIES ARE MODIFIED CONTROL IS RETURNED TO FM302 WHERE EACH 00060304
C ENTITY IS TESTED. A FUNCTION VALUE OF 999 IS RETURNED BUT IT IS 00070304
C NOT SIGNIFICANT NOR IS IT TESTED BY FM302. 00080304
C 00090304
IMPLICIT LOGICAL (L) 00100304
DIMENSION IACN11(4) 00110304
COMMON IVCN01 00120304
COMMON IVCN02, LVCN01 00130304
COMMON RVCN01, IVCN03 00140304
COMMON IVCN04,IVCN05,IACN11 00150304
COMMON /BLK5/IVCND1,IVCND2 00160304
COMMON IVCN06 00170304
COMMON /BLK5/RVCND1,LVCND1 00180304
COMMON IVCN07, IVCN08 00190304
COMMON /BLK6/RVCNE1 00200304
COMMON IVCN10 00210304
COMMON /BLK9/IVCNI1, IVCNI2, IVCNI3 00220304
COMMON IVCN12, IVCN13 00230304
COMMON /BLK10/IVCNJ1 00240304
COMMON /BLK11/IVCNK1 00250304
INTEGER FF305 00260304
C TEST 003 00270304
RVCN01 = 4.2 00280304
IVCN03 = IVCN03 + 1 00290304
C TEST 004 00300304
IVCN04 = 32 00310304
IVCN04 = IVCN04 / 4 00320304
IVCN05 = IVCN05 00330304
IACN11(1) = IACN11(1) + 4 00340304
IACN11(2) = IACN11(2) + 3 00350304
IACN11(3) = IACN11(3) + 2 00360304
IACN11(4) = IACN11(4) + 1 00370304
C TEST 008 00380304
IVCND1 = IVCND1 + 1 00390304
IVCND2 = IVCND2 + 1 00400304
C TEST 009 00410304
IVCN06 = IVCN06 + 1 00420304
RVCND1 = 4.5 00430304
LVCND1 = .TRUE. 00440304
IVCN07 = -IVCN07 00450304
IVCN08 = -3 00460304
RVCNE1 = -6.7 00470304
C TEST 012 00480304
IVCN10 = IVCN10 * IVCN10 00490304
C TEST 013 00500304
IVCNI1 = IVCNI1 + 1 00510304
IVCNI2 = IVCNI2 + 1 00520304
IVCNI3 = IVCNI3 + 1 00530304
C TEST 014 00540304
IVCN13 = 5 00550304
C TEST 015 00560304
IVCNK1 = 3 00570304
C 00580304
C FOR TESTS 014 AND 015 EXTERNAL FUNCTION FF305 IS REFERENCED 00590304
C 00600304
IVON99 = FF305 () 00610304
C TEST 014 00620304
IVCN12 = IVCN13 00630304
C TEST 015 00640304
IVCNJ1 = IVCNK1 00650304
FF304 = 999 00660304
RETURN 00670304
END 00680304
INTEGER FUNCTION FF305 () 00010305
C 00020305
C FF305 IS AN EXTERNAL FUNCTION WHICH IS USED IN TEST 014 AND 00030305
C 015 OF PROGRAM FM302. THIS SUBPROGRAM IS REFERENCED FROM EXTERNAL 00040305
C FUNCTION FF304. 00050305
C 00060305
COMMON IACN11(15) 00070305
COMMON IVCN12, IVCN13, IVCN14 00080305
COMMON /BLK10/IVCNJ1, /BLK11/IVCNK1 00090305
C TEST 014 00100305
IVCN14 = 11 00110305
IVCN13 = IVCN14 00120305
C TEST 015 00130305
IVCNK1 = 5 00140305
FF305 = 999 00150305
RETURN 00160305
END 00170305