|
|
1.1 ! root 1: C COMMENT SECTION 00010026 ! 2: C DATE***82/08/02*18.33.46 ! 3: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 4: C AUDIT FCVS78 V2.0 ! 5: C 00020026 ! 6: C FM026 00030026 ! 7: C 00040026 ! 8: C THIS ROUTINE CONTAINS THE BASIC SUBROUTINE REFERENCE TESTS. 00050026 ! 9: C THE SUBROUTINE FS027 IS CALLED BY THIS PROGRAM. THE SUBROUTINE 00060026 ! 10: C FS027 INCREMENTS THE CALLING ARGUMENT BY 1 AND RETURNS TO THE 00070026 ! 11: C CALLING PROGRAM. 00080026 ! 12: C 00090026 ! 13: C EXECUTION OF A SUBROUTINE REFERENCE RESULTS IN AN ASSOCIATION 00100026 ! 14: C OF ACTUAL ARGUMENTS WITH ALL APPEARANCES OF DUMMY ARGUMENTS IN 00110026 ! 15: C THE DEFINING SUBPROGRAM. FOLLOWING THESE ASSOCIATIONS, EXECUTION 00120026 ! 16: C OF THE FIRST EXECUTABLE STATEMENT OF THE DEFINING SUBPROGRAM 00130026 ! 17: C IS UNDERTAKEN. 00140026 ! 18: C 00150026 ! 19: C REFERENCES 00160026 ! 20: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00170026 ! 21: C X3.9-1978 00180026 ! 22: C 00190026 ! 23: C SECTION 15.6.2, SUBROUTINE REFERENCE 00200026 ! 24: C 00210026 ! 25: C ********************************************************** 00220026 ! 26: C 00230026 ! 27: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00240026 ! 28: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00250026 ! 29: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00260026 ! 30: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00270026 ! 31: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00280026 ! 32: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00290026 ! 33: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00300026 ! 34: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00310026 ! 35: C OF EXECUTING THESE TESTS. 00320026 ! 36: C 00330026 ! 37: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00340026 ! 38: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00350026 ! 39: C 00360026 ! 40: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00370026 ! 41: C 00380026 ! 42: C DEPARTMENT OF THE NAVY 00390026 ! 43: C FEDERAL COBOL COMPILER TESTING SERVICE 00400026 ! 44: C WASHINGTON, D.C. 20376 00410026 ! 45: C 00420026 ! 46: C ********************************************************** 00430026 ! 47: C 00440026 ! 48: C 00450026 ! 49: C 00460026 ! 50: C INITIALIZATION SECTION 00470026 ! 51: C 00480026 ! 52: C INITIALIZE CONSTANTS 00490026 ! 53: C ************** 00500026 ! 54: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00510026 ! 55: I01 = 5 00520026 ! 56: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00530026 ! 57: I02 = 6 00540026 ! 58: C SYSTEM ENVIRONMENT SECTION 00550026 ! 59: C 00560026 ! 60: I01 = 5 00570026 ! 61: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00580026 ! 62: C (UNIT NUMBER FOR CARD READER). 00590026 ! 63: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00600026 ! 64: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00610026 ! 65: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00620026 ! 66: C 00630026 ! 67: I02 = 6 00640026 ! 68: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00650026 ! 69: C (UNIT NUMBER FOR PRINTER). 00660026 ! 70: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00670026 ! 71: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00680026 ! 72: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00690026 ! 73: C 00700026 ! 74: IVPASS=0 00710026 ! 75: IVFAIL=0 00720026 ! 76: IVDELE=0 00730026 ! 77: ICZERO=0 00740026 ! 78: C 00750026 ! 79: C WRITE PAGE HEADERS 00760026 ! 80: WRITE (I02,90000) 00770026 ! 81: WRITE (I02,90001) 00780026 ! 82: WRITE (I02,90002) 00790026 ! 83: WRITE (I02, 90002) 00800026 ! 84: WRITE (I02,90003) 00810026 ! 85: WRITE (I02,90002) 00820026 ! 86: WRITE (I02,90004) 00830026 ! 87: WRITE (I02,90002) 00840026 ! 88: WRITE (I02,90011) 00850026 ! 89: WRITE (I02,90002) 00860026 ! 90: WRITE (I02,90002) 00870026 ! 91: WRITE (I02,90005) 00880026 ! 92: WRITE (I02,90006) 00890026 ! 93: WRITE (I02,90002) 00900026 ! 94: C 00910026 ! 95: C TEST SECTION 00920026 ! 96: C 00930026 ! 97: C SUBROUTINE REFERENCE - CALL 00940026 ! 98: C 00950026 ! 99: IVTNUM = 666 00960026 ! 100: C 00970026 ! 101: C **** TEST 666 **** 00980026 ! 102: C SUBROUTINE CALL - ARGUMENT NAME SAME AS SUBROUTINE ARGUMENT NAME. 00990026 ! 103: C 01000026 ! 104: IF (ICZERO) 36660, 6660, 36660 01010026 ! 105: 6660 CONTINUE 01020026 ! 106: IVON01 = 0 01030026 ! 107: CALL FS027(IVON01) 01040026 ! 108: IVCOMP = IVON01 01050026 ! 109: GO TO 46660 01060026 ! 110: 36660 IVDELE = IVDELE + 1 01070026 ! 111: WRITE (I02,80003) IVTNUM 01080026 ! 112: IF (ICZERO) 46660, 6671, 46660 01090026 ! 113: 46660 IF (IVCOMP - 1) 26660,16660,26660 01100026 ! 114: 16660 IVPASS = IVPASS + 1 01110026 ! 115: WRITE (I02,80001) IVTNUM 01120026 ! 116: GO TO 6671 01130026 ! 117: 26660 IVFAIL = IVFAIL + 1 01140026 ! 118: IVCORR = 1 01150026 ! 119: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01160026 ! 120: 6671 CONTINUE 01170026 ! 121: IVTNUM = 667 01180026 ! 122: C 01190026 ! 123: C **** TEST 667 **** 01200026 ! 124: C SUBROUTINE CALL - ARGUMENT NAME SAME AS INTERNAL VARIABLE IN 01210026 ! 125: C SUBROUTINE. 01220026 ! 126: C 01230026 ! 127: IF (ICZERO) 36670, 6670, 36670 01240026 ! 128: 6670 CONTINUE 01250026 ! 129: IVON02 = 2 01260026 ! 130: CALL FS027(IVON02) 01270026 ! 131: IVCOMP = IVON02 01280026 ! 132: GO TO 46670 01290026 ! 133: 36670 IVDELE = IVDELE + 1 01300026 ! 134: WRITE (I02,80003) IVTNUM 01310026 ! 135: IF (ICZERO) 46670, 6681, 46670 01320026 ! 136: 46670 IF (IVCOMP - 3) 26670,16670,26670 01330026 ! 137: 16670 IVPASS = IVPASS + 1 01340026 ! 138: WRITE (I02,80001) IVTNUM 01350026 ! 139: GO TO 6681 01360026 ! 140: 26670 IVFAIL = IVFAIL + 1 01370026 ! 141: IVCORR = 3 01380026 ! 142: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01390026 ! 143: 6681 CONTINUE 01400026 ! 144: IVTNUM = 668 01410026 ! 145: C 01420026 ! 146: C **** TEST 668 **** 01430026 ! 147: C SUBROUTINE CALL - ARGUMENT NAME DIFFERENT FROM SUBROUTINE ARGUMENT01440026 ! 148: C AND INTERNAL VARIABLE. 01450026 ! 149: C 01460026 ! 150: IF (ICZERO) 36680, 6680, 36680 01470026 ! 151: 6680 CONTINUE 01480026 ! 152: IVON01 = 7 01490026 ! 153: IVON03 = -12 01500026 ! 154: CALL FS027(IVON03) 01510026 ! 155: IVCOMP = IVON03 01520026 ! 156: GO TO 46680 01530026 ! 157: 36680 IVDELE = IVDELE + 1 01540026 ! 158: WRITE (I02,80003) IVTNUM 01550026 ! 159: IF (ICZERO) 46680, 6691, 46680 01560026 ! 160: 46680 IF (IVCOMP + 11 ) 26680,16680,26680 01570026 ! 161: 16680 IVPASS = IVPASS + 1 01580026 ! 162: WRITE (I02,80001) IVTNUM 01590026 ! 163: GO TO 6691 01600026 ! 164: 26680 IVFAIL = IVFAIL + 1 01610026 ! 165: IVCORR = -11 01620026 ! 166: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01630026 ! 167: 6691 CONTINUE 01640026 ! 168: IVTNUM = 669 01650026 ! 169: C 01660026 ! 170: C **** TEST 669 **** 01670026 ! 171: C REPEATED SUBROUTINE CALLS IN A DO LOOP. 01680026 ! 172: C 01690026 ! 173: IF (ICZERO) 36690, 6690, 36690 01700026 ! 174: 6690 CONTINUE 01710026 ! 175: IVCOMP = 0 01720026 ! 176: DO 6692 IVON04 = 1,5 01730026 ! 177: CALL FS027 (IVCOMP) 01740026 ! 178: 6692 CONTINUE 01750026 ! 179: GO TO 46690 01760026 ! 180: 36690 IVDELE = IVDELE + 1 01770026 ! 181: WRITE (I02,80003) IVTNUM 01780026 ! 182: IF (ICZERO) 46690, 6701, 46690 01790026 ! 183: 46690 IF (IVCOMP - 5) 26690,16690,26690 01800026 ! 184: 16690 IVPASS = IVPASS + 1 01810026 ! 185: WRITE (I02,80001) IVTNUM 01820026 ! 186: GO TO 6701 01830026 ! 187: 26690 IVFAIL = IVFAIL + 1 01840026 ! 188: IVCORR = 5 01850026 ! 189: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01860026 ! 190: C **** END OF TESTS **** 01870026 ! 191: 6701 CONTINUE 01880026 ! 192: C 01890026 ! 193: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 01900026 ! 194: 99999 CONTINUE 01910026 ! 195: WRITE (I02,90002) 01920026 ! 196: WRITE (I02,90006) 01930026 ! 197: WRITE (I02,90002) 01940026 ! 198: WRITE (I02,90002) 01950026 ! 199: WRITE (I02,90007) 01960026 ! 200: WRITE (I02,90002) 01970026 ! 201: WRITE (I02,90008) IVFAIL 01980026 ! 202: WRITE (I02,90009) IVPASS 01990026 ! 203: WRITE (I02,90010) IVDELE 02000026 ! 204: C 02010026 ! 205: C 02020026 ! 206: C TERMINATE ROUTINE EXECUTION 02030026 ! 207: STOP 02040026 ! 208: C 02050026 ! 209: C FORMAT STATEMENTS FOR PAGE HEADERS 02060026 ! 210: 90000 FORMAT (1H1) 02070026 ! 211: 90002 FORMAT (1H ) 02080026 ! 212: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02090026 ! 213: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 02100026 ! 214: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 02110026 ! 215: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 02120026 ! 216: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 02130026 ! 217: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 02140026 ! 218: C 02150026 ! 219: C FORMAT STATEMENTS FOR RUN SUMMARIES 02160026 ! 220: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 02170026 ! 221: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 02180026 ! 222: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 02190026 ! 223: C 02200026 ! 224: C FORMAT STATEMENTS FOR TEST RESULTS 02210026 ! 225: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 02220026 ! 226: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 02230026 ! 227: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 02240026 ! 228: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 02250026 ! 229: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 02260026 ! 230: C 02270026 ! 231: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM026) 02280026 ! 232: END 02290026 ! 233: SUBROUTINE FS027(IVON01) 00010027 ! 234: C DATE***82/08/02*18.33.46 ! 235: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 236: C AUDIT FCVS78 V2.0 ! 237: C COMMENT SECTION 00020027 ! 238: C 00030027 ! 239: C FS027 00040027 ! 240: C 00050027 ! 241: C THIS SUBROUTINE IS CALLED BY THE MAIN PROGRAM FM026. THE 00060027 ! 242: C SUBROUTINE ARGUMENT IS INCREMENTED BY 1 AND CONTROL RETURNED 00070027 ! 243: C TO THE CALLING PROGRAM. 00080027 ! 244: C 00090027 ! 245: C REFERENCES 00100027 ! 246: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110027 ! 247: C X3.9-1978 00120027 ! 248: C 00130027 ! 249: C SECTION 15.6, SUBROUTINES 00140027 ! 250: C SECTION 15.8, RETURN STATEMENT 00150027 ! 251: C 00160027 ! 252: C TEST SECTION 00170027 ! 253: C 00180027 ! 254: C SUBROUTINE SUBPROGRAM 00190027 ! 255: C 00200027 ! 256: C INCREMENT ARGUMENT BY 1 AND RETURN TO CALLING PROGRAM. 00210027 ! 257: C 00220027 ! 258: IVON02 = IVON01 00230027 ! 259: IVON02 = IVON02 + 1 00240027 ! 260: IVON01 = IVON02 00250027 ! 261: IVON02 = 300 00260027 ! 262: RETURN 00270027 ! 263: END 00280027
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.