C C COMMENT SECTION C C FM050 C C THIS ROUTINE CONTAINS BASIC SUBROUTINE AND FUNCTION REFERENCE C TESTS. FOUR SUBROUTINES AND ONE FUNCTION ARE CALLED OR C REFERENCED. FS051 IS CALLED TO TEST THE CALLING AND PASSING OF C ARGUMENTS THROUGH UNLABELED COMMON. NO ARGUMENTS ARE SPECIFIED C IN THE CALL LINE. FS052 IS IDENTICAL TO FS051 EXCEPT THAT SEVERAL C RETURNS ARE USED. FS053 UTILIZES MANY ARGUMENTS ON THE CALL C STATEMENT AND MANY RETURN STATEMENTS IN THE SUBROUTINE BODY. C FF054 IS A FUNCTION SUBROUTINE IN WHICH MANY ARGUMENTS AND RETURN C STATEMENTS ARE USED. AND FINALLY FS055 PASSES A ONE DIMENIONAL C ARRAY BACK TO FM050. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 15.5.2, REFERENCING AN EXTERNAL FUNCTION C SECTION 15.6.2, SUBROUTINE REFERENCE C COMMON RVCN01,IVCN01,IVCN02,IACN11(20) INTEGER FF054 C C ********************************************************** C C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT C OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - C C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ********************************************************** C C C C INITIALIZATION SECTION C C INITIALIZE CONSTANTS C ************** C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. I01 = 5 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. I02 = 6 C SYSTEM ENVIRONMENT SECTION C CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 C (UNIT NUMBER FOR CARD READER). CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. C CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 C (UNIT NUMBER FOR PRINTER). CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. C IVPASS=0 IVFAIL=0 IVDELE=0 ICZERO=0 C C WRITE PAGE HEADERS WRITE (I02,90000) WRITE (I02,90001) WRITE (I02,90002) WRITE (I02, 90002) WRITE (I02,90003) WRITE (I02,90002) WRITE (I02,90004) WRITE (I02,90002) WRITE (I02,90011) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90005) WRITE (I02,90006) WRITE (I02,90002) C TEST SECTION C C SUBROUTINE AND FUNCTION SUBPROGRAMS C 4001 CONTINUE IVTNUM = 400 C C **** TEST 400 **** C TEST 400 TESTS THE CALL TO A SUBROUTINE CONTAINING NO ARGUMENTS. C ALL PARAMETERS ARE PASSED THROUGH UNLABELED COMMON. C IF (ICZERO) 34000, 4000, 34000 4000 CONTINUE RVCN01 = 2.1654 CALL FS051 RVCOMP = RVCN01 GO TO 44000 34000 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 44000, 4011, 44000 44000 IF (RVCOMP - 3.1649) 24000,14000,44001 44001 IF (RVCOMP - 3.1659) 14000,14000,24000 14000 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 4011 24000 IVFAIL = IVFAIL + 1 RVCORR = 3.1654 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 4011 CONTINUE C C TEST 401 THROUGH TEST 403 TEST THE CALL TO SUBROUTINE FS052 WHICH C CONTAINS NO ARGUMENTS. ALL PARAMETERS ARE PASSED THROUGH C UNLABELED COMMON. SUBROUTINE FS052 CONTAIN SEVERAL RETURN C STATEMENTS. C IVTNUM = 401 C C **** TEST 401 **** C IF (ICZERO) 34010, 4010, 34010 4010 CONTINUE IVCN01 = 5 IVCN02 = 1 CALL FS052 IVCOMP = IVCN01 GO TO 44010 34010 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 44010, 4021, 44010 44010 IF (IVCOMP - 6) 24010,14010,24010 14010 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 4021 24010 IVFAIL = IVFAIL + 1 IVCORR = 6 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 4021 CONTINUE IVTNUM = 402 C C **** TEST 402 **** C IF (ICZERO) 34020, 4020, 34020 4020 CONTINUE IVCN01 = 10 IVCN02 = 5 CALL FS052 IVCOMP = IVCN01 GO TO 44020 34020 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 44020, 4031, 44020 44020 IF (IVCOMP - 15) 24020,14020,24020 14020 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 4031 24020 IVFAIL = IVFAIL + 1 IVCORR = 15 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 4031 CONTINUE IVTNUM = 403 C C **** TEST 403 **** C IF (ICZERO) 34030, 4030, 34030 4030 CONTINUE IVCN01 = 30 IVCN02 = 3 CALL FS052 IVCOMP = IVCN01 GO TO 44030 34030 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 44030, 4041, 44030 44030 IF (IVCOMP - 33) 24030,14030,24030 14030 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 4041 24030 IVFAIL = IVFAIL + 1 IVCORR = 33 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 4041 CONTINUE C C TEST 404 THROUGH TEST 406 TEST THE CALL TO SUBROUTINE FS053 WHICH C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS. C IVTNUM = 404 C C **** TEST 404 **** C IF (ICZERO) 34040, 4040, 34040 4040 CONTINUE CALL FS053 (6,10,11,IVON04,1) IVCOMP = IVON04 GO TO 44040 34040 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 44040, 4051, 44040 44040 IF (IVCOMP - 6) 24040,14040,24040 14040 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 4051 24040 IVFAIL = IVFAIL + 1 IVCORR = 6 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 4051 CONTINUE IVTNUM = 405 C C **** TEST 405 **** C IF (ICZERO) 34050, 4050, 34050 4050 CONTINUE IVCN01 = 10 CALL FS053 (6,IVCN01,11,IVON04,2) IVCOMP = IVON04 GO TO 44050 34050 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 44050, 4061, 44050 44050 IF (IVCOMP - 16) 24050,14050,24050 14050 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 4061 24050 IVFAIL = IVFAIL + 1 IVCORR = 16 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 4061 CONTINUE IVTNUM = 406 C C **** TEST 406 **** C IF (ICZERO) 34060, 4060, 34060 4060 CONTINUE IVON01 = 6 IVON02 = 10 IVON03 = 11 IVON05 = 3 CALL FS053 (IVON01,IVON02,IVON03,IVON04,IVON05) IVCOMP = IVON04 GO TO 44060 34060 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 44060, 4071, 44060 44060 IF (IVCOMP - 27) 24060,14060,24060 14060 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 4071 24060 IVFAIL = IVFAIL + 1 IVCORR = 27 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 4071 CONTINUE C C TEST 407 THROUGH 409 TEST THE REFERENCE TO FUNCTION FF054 WHICH C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS C IVTNUM = 407 C C **** TEST 407 **** C IF (ICZERO) 34070, 4070, 34070 4070 CONTINUE IVCOMP = FF054 (300,1,21,1) GO TO 44070 34070 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 44070, 4081, 44070 44070 IF (IVCOMP - 300) 24070,14070,24070 14070 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 4081 24070 IVFAIL = IVFAIL + 1 IVCORR = 300 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 4081 CONTINUE IVTNUM = 408 C C **** TEST 408 **** C IF (ICZERO) 34080, 4080, 34080 4080 CONTINUE IVON01 = 300 IVON04 = 2 IVCOMP = FF054 (IVON01,77,5,IVON04) GO TO 44080 34080 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 44080, 4091, 44080 44080 IF (IVCOMP - 377) 24080,14080,24080 14080 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 4091 24080 IVFAIL = IVFAIL + 1 IVCORR = 377 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 4091 CONTINUE IVTNUM = 409 C C **** TEST 409 **** C IF (ICZERO) 34090, 4090, 34090 4090 CONTINUE IVON01 = 71 IVON02 = 21 IVON03 = 17 IVON04 = 3 IVCOMP = FF054 (IVON01,IVON02,IVON03,IVON04) GO TO 44090 34090 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 44090, 4101, 44090 44090 IF (IVCOMP - 109) 24090,14090,24090 14090 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 4101 24090 IVFAIL = IVFAIL + 1 IVCORR = 109 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 4101 CONTINUE C C TEST 410 THROUGH 429 TEST THE CALL TO SUBROUTINE FS055 WHICH C CONTAINS NO ARGUMENTS. THE PARAMETERS ARE PASSED THROUGH AN C INTEGER ARRAY VARIABLE IN UNLABELED COMMON. C CALL FS055 DO 20 I = 1,20 IF (ICZERO) 34100, 4100, 34100 4100 CONTINUE IVTNUM = 409 + I IVCOMP = IACN11(I) GO TO 44100 34100 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 44100, 4111, 44100 44100 IF (IVCOMP - I) 24100,14100,24100 14100 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 4111 24100 IVFAIL = IVFAIL + 1 IVCORR = I WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 4111 CONTINUE 20 CONTINUE C C WRITE PAGE FOOTINGS AND RUN SUMMARIES 99999 CONTINUE WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90007) WRITE (I02,90002) WRITE (I02,90008) IVFAIL WRITE (I02,90009) IVPASS WRITE (I02,90010) IVDELE C C C TERMINATE ROUTINE EXECUTION STOP C C FORMAT STATEMENTS FOR PAGE HEADERS 90000 FORMAT (1H1) 90002 FORMAT (1H ) 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90003 FORMAT (1H ,21X,11HVERSION 1.0) 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 90006 FORMAT (1H ,5X,46H----------------------------------------------) 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARIES 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) C C FORMAT STATEMENTS FOR TEST RESULTS 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) C 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM050) END C C COMMENT SECTION C C FS051 C C FS051 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS051 C INCREMENTS THE VALUE OF A REAL VARIABLE BY 1 AND RETURNS CONTROL C TO THE CALLING PROGRAM FM050. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 15.6, SUBROUTINES C SECTION 15.8, RETURN STATEMENT C C TEST SECTION C C SUBROUTINE SUBPROGRAM - NO ARGUMENTS C SUBROUTINE FS051 COMMON //RVCN01 RVCN01 = RVCN01 + 1.0 RETURN END C C COMMENT SECTION C C FS052 C C FS052 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS052 C INCREMENTS THE VALUE OF ONE INTEGER VARIABLE BY 1,2,3,4 OR 5 C DEPENDING ON THE VALUE OF A SECOND INTEGER VARIABLE AND THEN C RETURNS CONTROL TO THE CALLING PROGRAM FM050. SEVERAL RETURN C STATEMENTS ARE INCLUDED. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 15.6, SUBROUTINES C SECTION 15.8, RETURN STATEMENT C C TEST SECTION C C SUBROUTINE SUBPROGRAM - NO ARGUMENTS, MANY RETURNS C SUBROUTINE FS052 COMMON RVDN01,IVCN01,IVCN02 GO TO (10,20,30,40,50),IVCN02 10 IVCN01 = IVCN01 + 1 RETURN 20 IVCN01 = IVCN01 + 2 RETURN 30 IVCN01 = IVCN01 + 3 RETURN 40 IVCN01 = IVCN01 + 4 RETURN 50 IVCN01 = IVCN01 + 5 RETURN END C C COMMENT SECTION C C FS053 C C FS053 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN C PROGRAM FM050. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE SUBROUTINE FS053 C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS C DEPENDING ON THE VALUE OF THE FIFTH ARGUMENT. THE RESULTING SUM C IS THEN RETURNED TO THE CALLING PROGRAM FM050 THROUGH THE FOURTH C ARGUMENT. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 15.6, SUBROUTINES C SECTION 15.8, RETURN STATEMENT C C TEST SECTION C C SUBROUTINE SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS C SUBROUTINE FS053 (IVON01,IVON02,IVON03,IVON04,IVON05) GO TO (10,20,30),IVON05 10 IVON04 = IVON01 RETURN 20 IVON04 = IVON01 + IVON02 RETURN 30 IVON04 = IVON01 + IVON02 + IVON03 RETURN END C C COMMENT SECTION C C FF054 C C FF054 IS A FUNCTION SUBPROGRAM WHICH IS REFERENCED BY THE C MAIN PROGRAM. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE FUNCTION FF054 C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS C DEPENDING ON THE VALUE OF THE FOURTH ARGUMENT. THE RESULTING SUM C IS THEN RETURNED TO THE REFERENCING PROGRAM FM050 THROUGH THE C FUNCTION REFERENCE. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT C SECTION 15.8, RETURN STATEMENT C C TEST SECTION C C FUNCTION SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS C INTEGER FUNCTION FF054 (IVON01,IVON02,IVON03,IVON04) GO TO (10,20,30),IVON04 10 FF054 = IVON01 RETURN 20 FF054 = IVON01 + IVON02 RETURN 30 FF054 = IVON01 + IVON02 + IVON03 RETURN END C C COMMENT SECTION C C FS055 C C FS055 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS055 C INITIALIZES A ONE DIMENSIONAL INTEGER ARRAY OF 20 ELEMENTS WITH C THE VALUES 1 THROUGH 20 RESPECTIVELY. CONTROL IS THEN RETURNED C TO THE CALLING PROGRAM FM050. C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 15.6, SUBROUTINES C SECTION 15.8, RETURN STATEMENT C C TEST SECTION C C SUBROUTINE SUBPROGRAM - ARRAY ARGUMENTS C SUBROUTINE FS055 COMMON RVCN01,IVCN01,IVCN02,IACN11 DIMENSION IACN11(20) DO 20 I = 1,20 IACN11(I) = I 20 CONTINUE RETURN END