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