| PROGRAM FM050 |
| |
| C 00010050 |
| C COMMENT SECTION 00020050 |
| C 00030050 |
| C FM050 00040050 |
| C 00050050 |
| C THIS ROUTINE CONTAINS BASIC SUBROUTINE AND FUNCTION REFERENCE00060050 |
| C TESTS. FOUR SUBROUTINES AND ONE FUNCTION ARE CALLED OR 00070050 |
| C REFERENCED. FS051 IS CALLED TO TEST THE CALLING AND PASSING OF 00080050 |
| C ARGUMENTS THROUGH UNLABELED COMMON. NO ARGUMENTS ARE SPECIFIED 00090050 |
| C IN THE CALL LINE. FS052 IS IDENTICAL TO FS051 EXCEPT THAT SEVERAL00100050 |
| C RETURNS ARE USED. FS053 UTILIZES MANY ARGUMENTS ON THE CALL 00110050 |
| C STATEMENT AND MANY RETURN STATEMENTS IN THE SUBROUTINE BODY. 00120050 |
| C FF054 IS A FUNCTION SUBROUTINE IN WHICH MANY ARGUMENTS AND RETURN 00130050 |
| C STATEMENTS ARE USED. AND FINALLY FS055 PASSES A ONE DIMENIONAL 00140050 |
| C ARRAY BACK TO FM050. 00150050 |
| C 00160050 |
| C REFERENCES 00170050 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00180050 |
| C X3.9-1978 00190050 |
| C 00200050 |
| C SECTION 15.5.2, REFERENCING AN EXTERNAL FUNCTION 00210050 |
| C SECTION 15.6.2, SUBROUTINE REFERENCE 00220050 |
| C 00230050 |
| COMMON RVCN01,IVCN01,IVCN02,IACN11(20) 00240050 |
| INTEGER FF054 00250050 |
| C 00260050 |
| C ********************************************************** 00270050 |
| C 00280050 |
| C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00290050 |
| C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00300050 |
| C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00310050 |
| C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00320050 |
| C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00330050 |
| C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00340050 |
| C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00350050 |
| C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00360050 |
| C OF EXECUTING THESE TESTS. 00370050 |
| C 00380050 |
| C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00390050 |
| C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00400050 |
| C 00410050 |
| C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00420050 |
| C 00430050 |
| C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00440050 |
| C SOFTWARE STANDARDS VALIDATION GROUP 00450050 |
| C BUILDING 225 RM A266 00460050 |
| C GAITHERSBURG, MD 20899 00470050 |
| C ********************************************************** 00480050 |
| C 00490050 |
| C 00500050 |
| C 00510050 |
| C INITIALIZATION SECTION 00520050 |
| C 00530050 |
| C INITIALIZE CONSTANTS 00540050 |
| C ************** 00550050 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00560050 |
| I01 = 5 00570050 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00580050 |
| I02 = 6 00590050 |
| C SYSTEM ENVIRONMENT SECTION 00600050 |
| C 00610050 |
| CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00620050 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00630050 |
| C (UNIT NUMBER FOR CARD READER). 00640050 |
| CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00650050 |
| C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00660050 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00670050 |
| C 00680050 |
| CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00690050 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00700050 |
| C (UNIT NUMBER FOR PRINTER). 00710050 |
| CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00720050 |
| C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00730050 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00740050 |
| C 00750050 |
| IVPASS=0 00760050 |
| IVFAIL=0 00770050 |
| IVDELE=0 00780050 |
| ICZERO=0 00790050 |
| C 00800050 |
| C WRITE PAGE HEADERS 00810050 |
| WRITE (I02,90000) 00820050 |
| WRITE (I02,90001) 00830050 |
| WRITE (I02,90002) 00840050 |
| WRITE (I02, 90002) 00850050 |
| WRITE (I02,90003) 00860050 |
| WRITE (I02,90002) 00870050 |
| WRITE (I02,90004) 00880050 |
| WRITE (I02,90002) 00890050 |
| WRITE (I02,90011) 00900050 |
| WRITE (I02,90002) 00910050 |
| WRITE (I02,90002) 00920050 |
| WRITE (I02,90005) 00930050 |
| WRITE (I02,90006) 00940050 |
| WRITE (I02,90002) 00950050 |
| C TEST SECTION 00960050 |
| C 00970050 |
| C SUBROUTINE AND FUNCTION SUBPROGRAMS 00980050 |
| C 00990050 |
| 4001 CONTINUE 01000050 |
| IVTNUM = 400 01010050 |
| C 01020050 |
| C **** TEST 400 **** 01030050 |
| C TEST 400 TESTS THE CALL TO A SUBROUTINE CONTAINING NO ARGUMENTS. 01040050 |
| C ALL PARAMETERS ARE PASSED THROUGH UNLABELED COMMON. 01050050 |
| C 01060050 |
| IF (ICZERO) 34000, 4000, 34000 01070050 |
| 4000 CONTINUE 01080050 |
| RVCN01 = 2.1654 01090050 |
| CALL FS051 01100050 |
| RVCOMP = RVCN01 01110050 |
| GO TO 44000 01120050 |
| 34000 IVDELE = IVDELE + 1 01130050 |
| WRITE (I02,80003) IVTNUM 01140050 |
| IF (ICZERO) 44000, 4011, 44000 01150050 |
| 44000 IF (RVCOMP - 3.1649) 24000,14000,44001 01160050 |
| 44001 IF (RVCOMP - 3.1659) 14000,14000,24000 01170050 |
| 14000 IVPASS = IVPASS + 1 01180050 |
| WRITE (I02,80001) IVTNUM 01190050 |
| GO TO 4011 01200050 |
| 24000 IVFAIL = IVFAIL + 1 01210050 |
| RVCORR = 3.1654 01220050 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01230050 |
| 4011 CONTINUE 01240050 |
| C 01250050 |
| C TEST 401 THROUGH TEST 403 TEST THE CALL TO SUBROUTINE FS052 WHICH 01260050 |
| C CONTAINS NO ARGUMENTS. ALL PARAMETERS ARE PASSED THROUGH 01270050 |
| C UNLABELED COMMON. SUBROUTINE FS052 CONTAIN SEVERAL RETURN 01280050 |
| C STATEMENTS. 01290050 |
| C 01300050 |
| IVTNUM = 401 01310050 |
| C 01320050 |
| C **** TEST 401 **** 01330050 |
| C 01340050 |
| IF (ICZERO) 34010, 4010, 34010 01350050 |
| 4010 CONTINUE 01360050 |
| IVCN01 = 5 01370050 |
| IVCN02 = 1 01380050 |
| CALL FS052 01390050 |
| IVCOMP = IVCN01 01400050 |
| GO TO 44010 01410050 |
| 34010 IVDELE = IVDELE + 1 01420050 |
| WRITE (I02,80003) IVTNUM 01430050 |
| IF (ICZERO) 44010, 4021, 44010 01440050 |
| 44010 IF (IVCOMP - 6) 24010,14010,24010 01450050 |
| 14010 IVPASS = IVPASS + 1 01460050 |
| WRITE (I02,80001) IVTNUM 01470050 |
| GO TO 4021 01480050 |
| 24010 IVFAIL = IVFAIL + 1 01490050 |
| IVCORR = 6 01500050 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01510050 |
| 4021 CONTINUE 01520050 |
| IVTNUM = 402 01530050 |
| C 01540050 |
| C **** TEST 402 **** 01550050 |
| C 01560050 |
| IF (ICZERO) 34020, 4020, 34020 01570050 |
| 4020 CONTINUE 01580050 |
| IVCN01 = 10 01590050 |
| IVCN02 = 5 01600050 |
| CALL FS052 01610050 |
| IVCOMP = IVCN01 01620050 |
| GO TO 44020 01630050 |
| 34020 IVDELE = IVDELE + 1 01640050 |
| WRITE (I02,80003) IVTNUM 01650050 |
| IF (ICZERO) 44020, 4031, 44020 01660050 |
| 44020 IF (IVCOMP - 15) 24020,14020,24020 01670050 |
| 14020 IVPASS = IVPASS + 1 01680050 |
| WRITE (I02,80001) IVTNUM 01690050 |
| GO TO 4031 01700050 |
| 24020 IVFAIL = IVFAIL + 1 01710050 |
| IVCORR = 15 01720050 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01730050 |
| 4031 CONTINUE 01740050 |
| IVTNUM = 403 01750050 |
| C 01760050 |
| C **** TEST 403 **** 01770050 |
| C 01780050 |
| IF (ICZERO) 34030, 4030, 34030 01790050 |
| 4030 CONTINUE 01800050 |
| IVCN01 = 30 01810050 |
| IVCN02 = 3 01820050 |
| CALL FS052 01830050 |
| IVCOMP = IVCN01 01840050 |
| GO TO 44030 01850050 |
| 34030 IVDELE = IVDELE + 1 01860050 |
| WRITE (I02,80003) IVTNUM 01870050 |
| IF (ICZERO) 44030, 4041, 44030 01880050 |
| 44030 IF (IVCOMP - 33) 24030,14030,24030 01890050 |
| 14030 IVPASS = IVPASS + 1 01900050 |
| WRITE (I02,80001) IVTNUM 01910050 |
| GO TO 4041 01920050 |
| 24030 IVFAIL = IVFAIL + 1 01930050 |
| IVCORR = 33 01940050 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01950050 |
| 4041 CONTINUE 01960050 |
| C 01970050 |
| C TEST 404 THROUGH TEST 406 TEST THE CALL TO SUBROUTINE FS053 WHICH 01980050 |
| C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS. 01990050 |
| C 02000050 |
| IVTNUM = 404 02010050 |
| C 02020050 |
| C **** TEST 404 **** 02030050 |
| C 02040050 |
| IF (ICZERO) 34040, 4040, 34040 02050050 |
| 4040 CONTINUE 02060050 |
| CALL FS053 (6,10,11,IVON04,1) 02070050 |
| IVCOMP = IVON04 02080050 |
| GO TO 44040 02090050 |
| 34040 IVDELE = IVDELE + 1 02100050 |
| WRITE (I02,80003) IVTNUM 02110050 |
| IF (ICZERO) 44040, 4051, 44040 02120050 |
| 44040 IF (IVCOMP - 6) 24040,14040,24040 02130050 |
| 14040 IVPASS = IVPASS + 1 02140050 |
| WRITE (I02,80001) IVTNUM 02150050 |
| GO TO 4051 02160050 |
| 24040 IVFAIL = IVFAIL + 1 02170050 |
| IVCORR = 6 02180050 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02190050 |
| 4051 CONTINUE 02200050 |
| IVTNUM = 405 02210050 |
| C 02220050 |
| C **** TEST 405 **** 02230050 |
| C 02240050 |
| IF (ICZERO) 34050, 4050, 34050 02250050 |
| 4050 CONTINUE 02260050 |
| IVCN01 = 10 02270050 |
| CALL FS053 (6,IVCN01,11,IVON04,2) 02280050 |
| IVCOMP = IVON04 02290050 |
| GO TO 44050 02300050 |
| 34050 IVDELE = IVDELE + 1 02310050 |
| WRITE (I02,80003) IVTNUM 02320050 |
| IF (ICZERO) 44050, 4061, 44050 02330050 |
| 44050 IF (IVCOMP - 16) 24050,14050,24050 02340050 |
| 14050 IVPASS = IVPASS + 1 02350050 |
| WRITE (I02,80001) IVTNUM 02360050 |
| GO TO 4061 02370050 |
| 24050 IVFAIL = IVFAIL + 1 02380050 |
| IVCORR = 16 02390050 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02400050 |
| 4061 CONTINUE 02410050 |
| IVTNUM = 406 02420050 |
| C 02430050 |
| C **** TEST 406 **** 02440050 |
| C 02450050 |
| IF (ICZERO) 34060, 4060, 34060 02460050 |
| 4060 CONTINUE 02470050 |
| IVON01 = 6 02480050 |
| IVON02 = 10 02490050 |
| IVON03 = 11 02500050 |
| IVON05 = 3 02510050 |
| CALL FS053 (IVON01,IVON02,IVON03,IVON04,IVON05) 02520050 |
| IVCOMP = IVON04 02530050 |
| GO TO 44060 02540050 |
| 34060 IVDELE = IVDELE + 1 02550050 |
| WRITE (I02,80003) IVTNUM 02560050 |
| IF (ICZERO) 44060, 4071, 44060 02570050 |
| 44060 IF (IVCOMP - 27) 24060,14060,24060 02580050 |
| 14060 IVPASS = IVPASS + 1 02590050 |
| WRITE (I02,80001) IVTNUM 02600050 |
| GO TO 4071 02610050 |
| 24060 IVFAIL = IVFAIL + 1 02620050 |
| IVCORR = 27 02630050 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02640050 |
| 4071 CONTINUE 02650050 |
| C 02660050 |
| C TEST 407 THROUGH 409 TEST THE REFERENCE TO FUNCTION FF054 WHICH 02670050 |
| C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS 02680050 |
| C 02690050 |
| IVTNUM = 407 02700050 |
| C 02710050 |
| C **** TEST 407 **** 02720050 |
| C 02730050 |
| IF (ICZERO) 34070, 4070, 34070 02740050 |
| 4070 CONTINUE 02750050 |
| IVCOMP = FF054 (300,1,21,1) 02760050 |
| GO TO 44070 02770050 |
| 34070 IVDELE = IVDELE + 1 02780050 |
| WRITE (I02,80003) IVTNUM 02790050 |
| IF (ICZERO) 44070, 4081, 44070 02800050 |
| 44070 IF (IVCOMP - 300) 24070,14070,24070 02810050 |
| 14070 IVPASS = IVPASS + 1 02820050 |
| WRITE (I02,80001) IVTNUM 02830050 |
| GO TO 4081 02840050 |
| 24070 IVFAIL = IVFAIL + 1 02850050 |
| IVCORR = 300 02860050 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02870050 |
| 4081 CONTINUE 02880050 |
| IVTNUM = 408 02890050 |
| C 02900050 |
| C **** TEST 408 **** 02910050 |
| C 02920050 |
| IF (ICZERO) 34080, 4080, 34080 02930050 |
| 4080 CONTINUE 02940050 |
| IVON01 = 300 02950050 |
| IVON04 = 2 02960050 |
| IVCOMP = FF054 (IVON01,77,5,IVON04) 02970050 |
| GO TO 44080 02980050 |
| 34080 IVDELE = IVDELE + 1 02990050 |
| WRITE (I02,80003) IVTNUM 03000050 |
| IF (ICZERO) 44080, 4091, 44080 03010050 |
| 44080 IF (IVCOMP - 377) 24080,14080,24080 03020050 |
| 14080 IVPASS = IVPASS + 1 03030050 |
| WRITE (I02,80001) IVTNUM 03040050 |
| GO TO 4091 03050050 |
| 24080 IVFAIL = IVFAIL + 1 03060050 |
| IVCORR = 377 03070050 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03080050 |
| 4091 CONTINUE 03090050 |
| IVTNUM = 409 03100050 |
| C 03110050 |
| C **** TEST 409 **** 03120050 |
| C 03130050 |
| IF (ICZERO) 34090, 4090, 34090 03140050 |
| 4090 CONTINUE 03150050 |
| IVON01 = 71 03160050 |
| IVON02 = 21 03170050 |
| IVON03 = 17 03180050 |
| IVON04 = 3 03190050 |
| IVCOMP = FF054 (IVON01,IVON02,IVON03,IVON04) 03200050 |
| GO TO 44090 03210050 |
| 34090 IVDELE = IVDELE + 1 03220050 |
| WRITE (I02,80003) IVTNUM 03230050 |
| IF (ICZERO) 44090, 4101, 44090 03240050 |
| 44090 IF (IVCOMP - 109) 24090,14090,24090 03250050 |
| 14090 IVPASS = IVPASS + 1 03260050 |
| WRITE (I02,80001) IVTNUM 03270050 |
| GO TO 4101 03280050 |
| 24090 IVFAIL = IVFAIL + 1 03290050 |
| IVCORR = 109 03300050 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03310050 |
| 4101 CONTINUE 03320050 |
| C 03330050 |
| C TEST 410 THROUGH 429 TEST THE CALL TO SUBROUTINE FS055 WHICH 03340050 |
| C CONTAINS NO ARGUMENTS. THE PARAMETERS ARE PASSED THROUGH AN 03350050 |
| C INTEGER ARRAY VARIABLE IN UNLABELED COMMON. 03360050 |
| C 03370050 |
| CALL FS055 03380050 |
| DO 20 I = 1,20 03390050 |
| IF (ICZERO) 34100, 4100, 34100 03400050 |
| 4100 CONTINUE 03410050 |
| IVTNUM = 409 + I 03420050 |
| IVCOMP = IACN11(I) 03430050 |
| GO TO 44100 03440050 |
| 34100 IVDELE = IVDELE + 1 03450050 |
| WRITE (I02,80003) IVTNUM 03460050 |
| IF (ICZERO) 44100, 4111, 44100 03470050 |
| 44100 IF (IVCOMP - I) 24100,14100,24100 03480050 |
| 14100 IVPASS = IVPASS + 1 03490050 |
| WRITE (I02,80001) IVTNUM 03500050 |
| GO TO 4111 03510050 |
| 24100 IVFAIL = IVFAIL + 1 03520050 |
| IVCORR = I 03530050 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03540050 |
| 4111 CONTINUE 03550050 |
| 20 CONTINUE 03560050 |
| C 03570050 |
| C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03580050 |
| 99999 CONTINUE 03590050 |
| WRITE (I02,90002) 03600050 |
| WRITE (I02,90006) 03610050 |
| WRITE (I02,90002) 03620050 |
| WRITE (I02,90002) 03630050 |
| WRITE (I02,90007) 03640050 |
| WRITE (I02,90002) 03650050 |
| WRITE (I02,90008) IVFAIL 03660050 |
| WRITE (I02,90009) IVPASS 03670050 |
| WRITE (I02,90010) IVDELE 03680050 |
| C 03690050 |
| C 03700050 |
| C TERMINATE ROUTINE EXECUTION 03710050 |
| STOP 03720050 |
| C 03730050 |
| C FORMAT STATEMENTS FOR PAGE HEADERS 03740050 |
| 90000 FORMAT ("1") 03750050 |
| 90002 FORMAT (" ") 03760050 |
| 90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03770050 |
| 90003 FORMAT (" ",21X,"VERSION 2.1" ) 03780050 |
| 90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03790050 |
| 90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03800050 |
| 90006 FORMAT (" ",5X,"----------------------------------------------" ) 03810050 |
| 90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03820050 |
| C 03830050 |
| C FORMAT STATEMENTS FOR RUN SUMMARIES 03840050 |
| 90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03850050 |
| 90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03860050 |
| 90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03870050 |
| C 03880050 |
| C FORMAT STATEMENTS FOR TEST RESULTS 03890050 |
| 80001 FORMAT (" ",4X,I5,7X,"PASS") 03900050 |
| 80002 FORMAT (" ",4X,I5,7X,"FAIL") 03910050 |
| 80003 FORMAT (" ",4X,I5,7X,"DELETED") 03920050 |
| 80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03930050 |
| 80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03940050 |
| C 03950050 |
| 90007 FORMAT (" ",20X,"END OF PROGRAM FM050" ) 03960050 |
| END 03970050 |
| |
| C 00010051 |
| C COMMENT SECTION 00020051 |
| C 00030051 |
| C FS051 00040051 |
| C 00050051 |
| C FS051 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060051 |
| C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070051 |
| C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS051 00080051 |
| C INCREMENTS THE VALUE OF A REAL VARIABLE BY 1 AND RETURNS CONTROL 00090051 |
| C TO THE CALLING PROGRAM FM050. 00100051 |
| C 00110051 |
| C REFERENCES 00120051 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130051 |
| C X3.9-1978 00140051 |
| C 00150051 |
| C SECTION 15.6, SUBROUTINES 00160051 |
| C SECTION 15.8, RETURN STATEMENT 00170051 |
| C 00180051 |
| C TEST SECTION 00190051 |
| C 00200051 |
| C SUBROUTINE SUBPROGRAM - NO ARGUMENTS 00210051 |
| C 00220051 |
| SUBROUTINE FS051 00230051 |
| COMMON //RVCN01 00240051 |
| RVCN01 = RVCN01 + 1.0 00250051 |
| RETURN 00260051 |
| END 00270051 |
| |
| C 00010052 |
| C COMMENT SECTION 00020052 |
| C 00030052 |
| C FS052 00040052 |
| C 00050052 |
| C FS052 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060052 |
| C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070052 |
| C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS052 00080052 |
| C INCREMENTS THE VALUE OF ONE INTEGER VARIABLE BY 1,2,3,4 OR 5 00090052 |
| C DEPENDING ON THE VALUE OF A SECOND INTEGER VARIABLE AND THEN 00100052 |
| C RETURNS CONTROL TO THE CALLING PROGRAM FM050. SEVERAL RETURN 00110052 |
| C STATEMENTS ARE INCLUDED. 00120052 |
| C 00130052 |
| C REFERENCES 00140052 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150052 |
| C X3.9-1978 00160052 |
| C 00170052 |
| C SECTION 15.6, SUBROUTINES 00180052 |
| C SECTION 15.8, RETURN STATEMENT 00190052 |
| C 00200052 |
| C TEST SECTION 00210052 |
| C 00220052 |
| C SUBROUTINE SUBPROGRAM - NO ARGUMENTS, MANY RETURNS 00230052 |
| C 00240052 |
| SUBROUTINE FS052 00250052 |
| COMMON RVDN01,IVCN01,IVCN02 00260052 |
| GO TO (10,20,30,40,50),IVCN02 00270052 |
| 10 IVCN01 = IVCN01 + 1 00280052 |
| RETURN 00290052 |
| 20 IVCN01 = IVCN01 + 2 00300052 |
| RETURN 00310052 |
| 30 IVCN01 = IVCN01 + 3 00320052 |
| RETURN 00330052 |
| 40 IVCN01 = IVCN01 + 4 00340052 |
| RETURN 00350052 |
| 50 IVCN01 = IVCN01 + 5 00360052 |
| RETURN 00370052 |
| END 00380052 |
| |
| C 00010053 |
| C COMMENT SECTION 00020053 |
| C 00030053 |
| C FS053 00040053 |
| C 00050053 |
| C FS053 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060053 |
| C PROGRAM FM050. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND 00070053 |
| C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE SUBROUTINE FS053 00080053 |
| C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS 00090053 |
| C DEPENDING ON THE VALUE OF THE FIFTH ARGUMENT. THE RESULTING SUM 00100053 |
| C IS THEN RETURNED TO THE CALLING PROGRAM FM050 THROUGH THE FOURTH 00110053 |
| C ARGUMENT. 00120053 |
| C 00130053 |
| C REFERENCES 00140053 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150053 |
| C X3.9-1978 00160053 |
| C 00170053 |
| C SECTION 15.6, SUBROUTINES 00180053 |
| C SECTION 15.8, RETURN STATEMENT 00190053 |
| C 00200053 |
| C TEST SECTION 00210053 |
| C 00220053 |
| C SUBROUTINE SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS 00230053 |
| C 00240053 |
| SUBROUTINE FS053 (IVON01,IVON02,IVON03,IVON04,IVON05) 00250053 |
| GO TO (10,20,30),IVON05 00260053 |
| 10 IVON04 = IVON01 00270053 |
| RETURN 00280053 |
| 20 IVON04 = IVON01 + IVON02 00290053 |
| RETURN 00300053 |
| 30 IVON04 = IVON01 + IVON02 + IVON03 00310053 |
| RETURN 00320053 |
| END 00330053 |
| |
| C 00010054 |
| C COMMENT SECTION 00020054 |
| C 00030054 |
| C FF054 00040054 |
| C 00050054 |
| C FF054 IS A FUNCTION SUBPROGRAM WHICH IS REFERENCED BY THE 00060054 |
| C MAIN PROGRAM. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND 00070054 |
| C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE FUNCTION FF054 00080054 |
| C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS 00090054 |
| C DEPENDING ON THE VALUE OF THE FOURTH ARGUMENT. THE RESULTING SUM 00100054 |
| C IS THEN RETURNED TO THE REFERENCING PROGRAM FM050 THROUGH THE 00110054 |
| C FUNCTION REFERENCE. 00120054 |
| C 00130054 |
| C REFERENCES 00140054 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150054 |
| C X3.9-1978 00160054 |
| C 00170054 |
| C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00180054 |
| C SECTION 15.8, RETURN STATEMENT 00190054 |
| C 00200054 |
| C TEST SECTION 00210054 |
| C 00220054 |
| C FUNCTION SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS 00230054 |
| C 00240054 |
| INTEGER FUNCTION FF054 (IVON01,IVON02,IVON03,IVON04) 00250054 |
| GO TO (10,20,30),IVON04 00260054 |
| 10 FF054 = IVON01 00270054 |
| RETURN 00280054 |
| 20 FF054 = IVON01 + IVON02 00290054 |
| RETURN 00300054 |
| 30 FF054 = IVON01 + IVON02 + IVON03 00310054 |
| RETURN 00320054 |
| END 00330054 |
| |
| C 00010055 |
| C COMMENT SECTION 00020055 |
| C 00030055 |
| C FS055 00040055 |
| C 00050055 |
| C FS055 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060055 |
| C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070055 |
| C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS055 00080055 |
| C INITIALIZES A ONE DIMENSIONAL INTEGER ARRAY OF 20 ELEMENTS WITH 00090055 |
| C THE VALUES 1 THROUGH 20 RESPECTIVELY. CONTROL IS THEN RETURNED 00100055 |
| C TO THE CALLING PROGRAM FM050. 00110055 |
| C 00120055 |
| C REFERENCES 00130055 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140055 |
| C X3.9-1978 00150055 |
| C 00160055 |
| C SECTION 15.6, SUBROUTINES 00170055 |
| C SECTION 15.8, RETURN STATEMENT 00180055 |
| C 00190055 |
| C TEST SECTION 00200055 |
| C 00210055 |
| C SUBROUTINE SUBPROGRAM - ARRAY ARGUMENTS 00220055 |
| C 00230055 |
| SUBROUTINE FS055 00240055 |
| COMMON RVCN01,IVCN01,IVCN02,IACN11 00250055 |
| DIMENSION IACN11(20) 00260055 |
| DO 20 I = 1,20 00270055 |
| IACN11(I) = I 00280055 |
| 20 CONTINUE 00290055 |
| RETURN 00300055 |
| END 00310055 |
