![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM056.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests|
Return to FM056.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: C 00010056 ! 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 COMMENT SECTION 00020056 ! 6: C 00030056 ! 7: C FM056 00040056 ! 8: C 00050056 ! 9: C FM056 IS A MAIN WHICH TESTS THE ARGUMENT PASSING LINKAGE OF 00060056 ! 10: C A 2 LEVEL NESTED SUBROUTINE AND AN EXTERNAL FUNCTION REFERENCE. 00070056 ! 11: C THE MAIN PROGRAM FM056 CALLS SUBROUTINE FS057 PASSING ONE 00080056 ! 12: C ARGUMENT. SUBROUTINE FS057 CALLS SUBROUTINE FS058 PASSING TWO 00090056 ! 13: C ARGUMENTS. SUBROUTINE FS058 REFERENCES EXTERNAL FUNCTION FF059 00100056 ! 14: C PASSING 3 ARGUMENTS. FUNCTION FF059 ADDS THE VALUES OF THE 3 00110056 ! 15: C ARGUMENTS TOGETHER. SUBROUTINE FS057 AND FS058 THEN MERELY 00120056 ! 16: C RETURN THE RESULT TO FM056 IN THE FIRST ARGUMENT. 00130056 ! 17: C 00140056 ! 18: C THE VALUES OF THE ARGUMENTS THAT ARE PASSED TO EACH 00150056 ! 19: C SUBPROGRAM AND FUNCTION, AND RETURNED TO THE CALLING OR 00160056 ! 20: C REFERENCING PROGRAM ARE SAVED IN AN INTEGER ARRAY. FM056 THEN 00170056 ! 21: C USES THESE VALUES TO TEST THE COMPILER'S ARGUMENT PASSING 00180056 ! 22: C CAPABILITIES. 00190056 ! 23: C 00200056 ! 24: C REFERENCES 00210056 ! 25: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00220056 ! 26: C X3.9-1978 00230056 ! 27: C 00240056 ! 28: C SECTION 15.6.2, SUBROUTINE REFERENCE 00250056 ! 29: COMMON IACN11 (12) 00260056 ! 30: C 00270056 ! 31: C ********************************************************** 00280056 ! 32: C 00290056 ! 33: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00300056 ! 34: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00310056 ! 35: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00320056 ! 36: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00330056 ! 37: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00340056 ! 38: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00350056 ! 39: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00360056 ! 40: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00370056 ! 41: C OF EXECUTING THESE TESTS. 00380056 ! 42: C 00390056 ! 43: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00400056 ! 44: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00410056 ! 45: C 00420056 ! 46: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00430056 ! 47: C 00440056 ! 48: C DEPARTMENT OF THE NAVY 00450056 ! 49: C FEDERAL COBOL COMPILER TESTING SERVICE 00460056 ! 50: C WASHINGTON, D.C. 20376 00470056 ! 51: C 00480056 ! 52: C ********************************************************** 00490056 ! 53: C 00500056 ! 54: C 00510056 ! 55: C 00520056 ! 56: C INITIALIZATION SECTION 00530056 ! 57: C 00540056 ! 58: C INITIALIZE CONSTANTS 00550056 ! 59: C ************** 00560056 ! 60: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00570056 ! 61: I01 = 5 00580056 ! 62: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00590056 ! 63: I02 = 6 00600056 ! 64: C SYSTEM ENVIRONMENT SECTION 00610056 ! 65: C 00620056 ! 66: I01 = 5 00630056 ! 67: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00640056 ! 68: C (UNIT NUMBER FOR CARD READER). 00650056 ! 69: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00660056 ! 70: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670056 ! 71: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00680056 ! 72: C 00690056 ! 73: I02 = 6 00700056 ! 74: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00710056 ! 75: C (UNIT NUMBER FOR PRINTER). 00720056 ! 76: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00730056 ! 77: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00740056 ! 78: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00750056 ! 79: C 00760056 ! 80: IVPASS=0 00770056 ! 81: IVFAIL=0 00780056 ! 82: IVDELE=0 00790056 ! 83: ICZERO=0 00800056 ! 84: C 00810056 ! 85: C WRITE PAGE HEADERS 00820056 ! 86: WRITE (I02,90000) 00830056 ! 87: WRITE (I02,90001) 00840056 ! 88: WRITE (I02,90002) 00850056 ! 89: WRITE (I02, 90002) 00860056 ! 90: WRITE (I02,90003) 00870056 ! 91: WRITE (I02,90002) 00880056 ! 92: WRITE (I02,90004) 00890056 ! 93: WRITE (I02,90002) 00900056 ! 94: WRITE (I02,90011) 00910056 ! 95: WRITE (I02,90002) 00920056 ! 96: WRITE (I02,90002) 00930056 ! 97: WRITE (I02,90005) 00940056 ! 98: WRITE (I02,90006) 00950056 ! 99: WRITE (I02,90002) 00960056 ! 100: C 00970056 ! 101: C TEST SECTION 00980056 ! 102: C 00990056 ! 103: C SUBROUTINE SUBPROGRAM 01000056 ! 104: C 01010056 ! 105: IVON01 = 5 01020056 ! 106: CALL FS057 (IVON01) 01030056 ! 107: IACN11 (12) = IVON01 01040056 ! 108: IVTNUM = 430 01050056 ! 109: C 01060056 ! 110: C **** TEST 430 **** 01070056 ! 111: C 01080056 ! 112: C TEST 430 TESTS THE VALUE OF THE ARGUMENT RECEIVED BY FS057 FROM 01090056 ! 113: C A FM056 CALL TO FS057 01100056 ! 114: C 01110056 ! 115: IF (ICZERO) 34300, 4300, 34300 01120056 ! 116: 4300 CONTINUE 01130056 ! 117: IVCOMP = IACN11 (1) 01140056 ! 118: GO TO 44300 01150056 ! 119: 34300 IVDELE = IVDELE + 1 01160056 ! 120: WRITE (I02,80003) IVTNUM 01170056 ! 121: IF (ICZERO) 44300, 4311, 44300 01180056 ! 122: 44300 IF (IVCOMP - 5) 24300,14300,24300 01190056 ! 123: 14300 IVPASS = IVPASS + 1 01200056 ! 124: WRITE (I02,80001) IVTNUM 01210056 ! 125: GO TO 4311 01220056 ! 126: 24300 IVFAIL = IVFAIL + 1 01230056 ! 127: IVCORR = 5 01240056 ! 128: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01250056 ! 129: 4311 CONTINUE 01260056 ! 130: IVTNUM = 431 01270056 ! 131: C 01280056 ! 132: C **** TEST 431 **** 01290056 ! 133: C 01300056 ! 134: C TEST 431 TESTS THE VALUE OF THE SECOND ARGUMENT THAT WAS PASSED 01310056 ! 135: C FROM A FS057 CALL TO FS058 01320056 ! 136: C 01330056 ! 137: C 01340056 ! 138: IF (ICZERO) 34310, 4310, 34310 01350056 ! 139: 4310 CONTINUE 01360056 ! 140: IVCOMP = IACN11 (2) 01370056 ! 141: GO TO 44310 01380056 ! 142: 34310 IVDELE = IVDELE + 1 01390056 ! 143: WRITE (I02,80003) IVTNUM 01400056 ! 144: IF (ICZERO) 44310, 4321, 44310 01410056 ! 145: 44310 IF (IVCOMP - 4) 24310,14310,24310 01420056 ! 146: 14310 IVPASS = IVPASS + 1 01430056 ! 147: WRITE (I02,80001) IVTNUM 01440056 ! 148: GO TO 4321 01450056 ! 149: 24310 IVFAIL = IVFAIL + 1 01460056 ! 150: IVCORR = 4 01470056 ! 151: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01480056 ! 152: 4321 CONTINUE 01490056 ! 153: IVTNUM = 432 01500056 ! 154: C 01510056 ! 155: C **** TEST 432 **** 01520056 ! 156: C 01530056 ! 157: C TEST 432 TESTS THE VALUE OF THE FIRST ARGUMENT RECEIVED BY FS058 01540056 ! 158: C FROM A FS057 CALL TO FS058 01550056 ! 159: C 01560056 ! 160: C 01570056 ! 161: IF (ICZERO) 34320, 4320, 34320 01580056 ! 162: 4320 CONTINUE 01590056 ! 163: IVCOMP = IACN11 (3) 01600056 ! 164: GO TO 44320 01610056 ! 165: 34320 IVDELE = IVDELE + 1 01620056 ! 166: WRITE (I02,80003) IVTNUM 01630056 ! 167: IF (ICZERO) 44320, 4331, 44320 01640056 ! 168: 44320 IF (IVCOMP - 5) 24320,14320,24320 01650056 ! 169: 14320 IVPASS = IVPASS + 1 01660056 ! 170: WRITE (I02,80001) IVTNUM 01670056 ! 171: GO TO 4331 01680056 ! 172: 24320 IVFAIL = IVFAIL + 1 01690056 ! 173: IVCORR = 5 01700056 ! 174: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01710056 ! 175: 4331 CONTINUE 01720056 ! 176: IVTNUM = 433 01730056 ! 177: C 01740056 ! 178: C **** TEST 433 **** 01750056 ! 179: C 01760056 ! 180: C TEST 433 TESTS THE VALUE OF THE SECOND ARGUMENT RECEIVED BY FS058 01770056 ! 181: C FROM A FS057 CALL TO FS058 01780056 ! 182: C 01790056 ! 183: C 01800056 ! 184: IF (ICZERO) 34330, 4330, 34330 01810056 ! 185: 4330 CONTINUE 01820056 ! 186: IVCOMP = IACN11 (4) 01830056 ! 187: GO TO 44330 01840056 ! 188: 34330 IVDELE = IVDELE + 1 01850056 ! 189: WRITE (I02,80003) IVTNUM 01860056 ! 190: IF (ICZERO) 44330, 4341, 44330 01870056 ! 191: 44330 IF (IVCOMP - 4) 24330,14330,24330 01880056 ! 192: 14330 IVPASS = IVPASS + 1 01890056 ! 193: WRITE (I02,80001) IVTNUM 01900056 ! 194: GO TO 4341 01910056 ! 195: 24330 IVFAIL = IVFAIL + 1 01920056 ! 196: IVCORR = 4 01930056 ! 197: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01940056 ! 198: 4341 CONTINUE 01950056 ! 199: IVTNUM = 434 01960056 ! 200: C 01970056 ! 201: C **** TEST 434 **** 01980056 ! 202: C 01990056 ! 203: C TEST 434 TESTS THE VALUE OF THE THIRD ARGUMENT THAT WAS PASSED 02000056 ! 204: C FROM A FS058 REFERENCE OF FUNCTION FF059 02010056 ! 205: C 02020056 ! 206: C 02030056 ! 207: IF (ICZERO) 34340, 4340, 34340 02040056 ! 208: 4340 CONTINUE 02050056 ! 209: IVCOMP = IACN11 (5) 02060056 ! 210: GO TO 44340 02070056 ! 211: 34340 IVDELE = IVDELE + 1 02080056 ! 212: WRITE (I02,80003) IVTNUM 02090056 ! 213: IF (ICZERO) 44340, 4351, 44340 02100056 ! 214: 44340 IF (IVCOMP - 3) 24340,14340,24340 02110056 ! 215: 14340 IVPASS = IVPASS + 1 02120056 ! 216: WRITE (I02,80001) IVTNUM 02130056 ! 217: GO TO 4351 02140056 ! 218: 24340 IVFAIL = IVFAIL + 1 02150056 ! 219: IVCORR = 3 02160056 ! 220: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02170056 ! 221: 4351 CONTINUE 02180056 ! 222: IVTNUM = 435 02190056 ! 223: C 02200056 ! 224: C **** TEST 435 **** 02210056 ! 225: C 02220056 ! 226: C TEST 435 TESTS THE VALUE OF THE FIRST ARGUMENT RECEIVED BY FF059 02230056 ! 227: C FROM A FS058 REFERENCE OF FUNCTION FF059 02240056 ! 228: C 02250056 ! 229: C 02260056 ! 230: IF (ICZERO) 34350, 4350, 34350 02270056 ! 231: 4350 CONTINUE 02280056 ! 232: IVCOMP = IACN11 (6) 02290056 ! 233: GO TO 44350 02300056 ! 234: 34350 IVDELE = IVDELE + 1 02310056 ! 235: WRITE (I02,80003) IVTNUM 02320056 ! 236: IF (ICZERO) 44350, 4361, 44350 02330056 ! 237: 44350 IF (IVCOMP - 5) 24350,14350,24350 02340056 ! 238: 14350 IVPASS = IVPASS + 1 02350056 ! 239: WRITE (I02,80001) IVTNUM 02360056 ! 240: GO TO 4361 02370056 ! 241: 24350 IVFAIL = IVFAIL + 1 02380056 ! 242: IVCORR = 5 02390056 ! 243: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02400056 ! 244: 4361 CONTINUE 02410056 ! 245: IVTNUM = 436 02420056 ! 246: C 02430056 ! 247: C **** TEST 436 **** 02440056 ! 248: C 02450056 ! 249: C TEST 436 TESTS THE VALUE OF THE SECOND ARGUMENT RECEIVED BY FF059 02460056 ! 250: C FROM A FS058 REFERENCE OF FUNCTION FF059 02470056 ! 251: C 02480056 ! 252: C 02490056 ! 253: IF (ICZERO) 34360, 4360, 34360 02500056 ! 254: 4360 CONTINUE 02510056 ! 255: IVCOMP = IACN11 (7) 02520056 ! 256: GO TO 44360 02530056 ! 257: 34360 IVDELE = IVDELE + 1 02540056 ! 258: WRITE (I02,80003) IVTNUM 02550056 ! 259: IF (ICZERO) 44360, 4371, 44360 02560056 ! 260: 44360 IF (IVCOMP - 4) 24360,14360,24360 02570056 ! 261: 14360 IVPASS = IVPASS + 1 02580056 ! 262: WRITE (I02,80001) IVTNUM 02590056 ! 263: GO TO 4371 02600056 ! 264: 24360 IVFAIL = IVFAIL + 1 02610056 ! 265: IVCORR = 4 02620056 ! 266: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02630056 ! 267: 4371 CONTINUE 02640056 ! 268: IVTNUM = 437 02650056 ! 269: C 02660056 ! 270: C **** TEST 437 **** 02670056 ! 271: C 02680056 ! 272: C TEST 437 TESTS THE VALUE OF THE THIRD ARGUMENT RECEIVED BY FF059 02690056 ! 273: C FROM A FS058 REFERENCE OF FUNCTION FF059 02700056 ! 274: C 02710056 ! 275: C 02720056 ! 276: IF (ICZERO) 34370, 4370, 34370 02730056 ! 277: 4370 CONTINUE 02740056 ! 278: IVCOMP = IACN11 (8) 02750056 ! 279: GO TO 44370 02760056 ! 280: 34370 IVDELE = IVDELE + 1 02770056 ! 281: WRITE (I02,80003) IVTNUM 02780056 ! 282: IF (ICZERO) 44370, 4381, 44370 02790056 ! 283: 44370 IF (IVCOMP - 3) 24370,14370,24370 02800056 ! 284: 14370 IVPASS = IVPASS + 1 02810056 ! 285: WRITE (I02,80001) IVTNUM 02820056 ! 286: GO TO 4381 02830056 ! 287: 24370 IVFAIL = IVFAIL + 1 02840056 ! 288: IVCORR = 3 02850056 ! 289: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02860056 ! 290: 4381 CONTINUE 02870056 ! 291: IVTNUM = 438 02880056 ! 292: C 02890056 ! 293: C **** TEST 438 **** 02900056 ! 294: C 02910056 ! 295: C TEST 438 TESTS THE VALUE OF THE FUNCTION DETERMINED BY FF059 02920056 ! 296: C 02930056 ! 297: C 02940056 ! 298: IF (ICZERO) 34380, 4380, 34380 02950056 ! 299: 4380 CONTINUE 02960056 ! 300: IVCOMP = IACN11 (9) 02970056 ! 301: GO TO 44380 02980056 ! 302: 34380 IVDELE = IVDELE + 1 02990056 ! 303: WRITE (I02,80003) IVTNUM 03000056 ! 304: IF (ICZERO) 44380, 4391, 44380 03010056 ! 305: 44380 IF (IVCOMP - 12) 24380,14380,24380 03020056 ! 306: 14380 IVPASS = IVPASS + 1 03030056 ! 307: WRITE (I02,80001) IVTNUM 03040056 ! 308: GO TO 4391 03050056 ! 309: 24380 IVFAIL = IVFAIL + 1 03060056 ! 310: IVCORR = 12 03070056 ! 311: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03080056 ! 312: 4391 CONTINUE 03090056 ! 313: IVTNUM = 439 03100056 ! 314: C 03110056 ! 315: C **** TEST 439 **** 03120056 ! 316: C 03130056 ! 317: C TEST 439 TESTS THE VALUE OF THE FUNCTION RETURNED TO FS058 BY 03140056 ! 318: C FF059 03150056 ! 319: C 03160056 ! 320: C 03170056 ! 321: IF (ICZERO) 34390, 4390, 34390 03180056 ! 322: 4390 CONTINUE 03190056 ! 323: IVCOMP = IACN11 (10) 03200056 ! 324: GO TO 44390 03210056 ! 325: 34390 IVDELE = IVDELE + 1 03220056 ! 326: WRITE (I02,80003) IVTNUM 03230056 ! 327: IF (ICZERO) 44390, 4401, 44390 03240056 ! 328: 44390 IF (IVCOMP - 12) 24390,14390,24390 03250056 ! 329: 14390 IVPASS = IVPASS + 1 03260056 ! 330: WRITE (I02,80001) IVTNUM 03270056 ! 331: GO TO 4401 03280056 ! 332: 24390 IVFAIL = IVFAIL + 1 03290056 ! 333: IVCORR = 12 03300056 ! 334: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03310056 ! 335: 4401 CONTINUE 03320056 ! 336: IVTNUM = 440 03330056 ! 337: C 03340056 ! 338: C **** TEST 440 **** 03350056 ! 339: C 03360056 ! 340: C TEST 440 TESTS THE VALUE OF THE FIRST ARGUMENT RETURNED TO FS057 03370056 ! 341: C BY FS058 03380056 ! 342: C 03390056 ! 343: IF (ICZERO) 34400, 4400, 34400 03400056 ! 344: 4400 CONTINUE 03410056 ! 345: IVCOMP = IACN11 (11) 03420056 ! 346: GO TO 44400 03430056 ! 347: 34400 IVDELE = IVDELE + 1 03440056 ! 348: WRITE (I02,80003) IVTNUM 03450056 ! 349: IF (ICZERO) 44400, 4411, 44400 03460056 ! 350: 44400 IF (IVCOMP - 12) 24400,14400,24400 03470056 ! 351: 14400 IVPASS = IVPASS + 1 03480056 ! 352: WRITE (I02,80001) IVTNUM 03490056 ! 353: GO TO 4411 03500056 ! 354: 24400 IVFAIL = IVFAIL + 1 03510056 ! 355: IVCORR = 12 03520056 ! 356: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03530056 ! 357: 4411 CONTINUE 03540056 ! 358: IVTNUM = 441 03550056 ! 359: C 03560056 ! 360: C **** TEST 441 **** 03570056 ! 361: C 03580056 ! 362: C TEST 441 TESTS THE VALUE OF THE FIRST ARGUMENT RETURNED TO FM056 03590056 ! 363: C BY FS057 03600056 ! 364: C 03610056 ! 365: C 03620056 ! 366: IF (ICZERO) 34410, 4410, 34410 03630056 ! 367: 4410 CONTINUE 03640056 ! 368: IVCOMP = IACN11 (12) 03650056 ! 369: GO TO 44410 03660056 ! 370: 34410 IVDELE = IVDELE + 1 03670056 ! 371: WRITE (I02,80003) IVTNUM 03680056 ! 372: IF (ICZERO) 44410, 4421, 44410 03690056 ! 373: 44410 IF (IVCOMP - 12) 24410,14410,24410 03700056 ! 374: 14410 IVPASS = IVPASS + 1 03710056 ! 375: WRITE (I02,80001) IVTNUM 03720056 ! 376: GO TO 4421 03730056 ! 377: 24410 IVFAIL = IVFAIL + 1 03740056 ! 378: IVCORR = 12 03750056 ! 379: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03760056 ! 380: 4421 CONTINUE 03770056 ! 381: C 03780056 ! 382: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03790056 ! 383: 99999 CONTINUE 03800056 ! 384: WRITE (I02,90002) 03810056 ! 385: WRITE (I02,90006) 03820056 ! 386: WRITE (I02,90002) 03830056 ! 387: WRITE (I02,90002) 03840056 ! 388: WRITE (I02,90007) 03850056 ! 389: WRITE (I02,90002) 03860056 ! 390: WRITE (I02,90008) IVFAIL 03870056 ! 391: WRITE (I02,90009) IVPASS 03880056 ! 392: WRITE (I02,90010) IVDELE 03890056 ! 393: C 03900056 ! 394: C 03910056 ! 395: C TERMINATE ROUTINE EXECUTION 03920056 ! 396: STOP 03930056 ! 397: C 03940056 ! 398: C FORMAT STATEMENTS FOR PAGE HEADERS 03950056 ! 399: 90000 FORMAT (1H1) 03960056 ! 400: 90002 FORMAT (1H ) 03970056 ! 401: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03980056 ! 402: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 03990056 ! 403: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 04000056 ! 404: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 04010056 ! 405: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 04020056 ! 406: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 04030056 ! 407: C 04040056 ! 408: C FORMAT STATEMENTS FOR RUN SUMMARIES 04050056 ! 409: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 04060056 ! 410: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 04070056 ! 411: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 04080056 ! 412: C 04090056 ! 413: C FORMAT STATEMENTS FOR TEST RESULTS 04100056 ! 414: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 04110056 ! 415: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 04120056 ! 416: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 04130056 ! 417: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 04140056 ! 418: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 04150056 ! 419: C 04160056 ! 420: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM056) 04170056 ! 421: END 04180056 ! 422: C 00010057 ! 423: C DATE***82/08/02*18.33.46 ! 424: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 425: C AUDIT FCVS78 V2.0 ! 426: C COMMENT SECTION 00020057 ! 427: C 00030057 ! 428: C FS057 00040057 ! 429: C 00050057 ! 430: C THIS SUBROUTINE IS CALLED BY THE MAIN PROGRAM FM056. THE 00060057 ! 431: C SINGLE ARGUMENT PASSED FROM FM056 ALONG WITH A SECOND PARAMETER 00070057 ! 432: C CREATED IN FS057 ARE THEN PASSED VIA A CALL TO SUBROUTINE FS058. 00080057 ! 433: C A RESULT FROM AN ARITHMETIC OPERATION IS RETURNED FROM FS058 IN 00090057 ! 434: C THE FIRST ARGUMENT. FS057 ACCEPTS THIS RESULT AND RETURNS CONTROL00100057 ! 435: C TO FM056 WITHOUT ANY ADDITIONAL PROCESSING. 00110057 ! 436: C 00120057 ! 437: C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FM056 TO 00130057 ! 438: C FS057 AND RETURNED ARE SAVED IN AN INTEGER ARRAY FOR LATER 00140057 ! 439: C VERIFICATION BY THE MAIN PROGRAM. 00150057 ! 440: C 00160057 ! 441: C REFERENCES 00170057 ! 442: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00180057 ! 443: C X3.9-1978 00190057 ! 444: C 00200057 ! 445: C SECTION 15.6, SUBROUTINES 00210057 ! 446: C SECTION 15.6.2, SUBROUTINE REFERENCE 00220057 ! 447: C SECTION 15.8, RETURN STATEMENT 00230057 ! 448: C 00240057 ! 449: C TEST SECTION 00250057 ! 450: C 00260057 ! 451: C SUBROUTINE SUBPROGRAM 00270057 ! 452: C 00280057 ! 453: SUBROUTINE FS057 (IVON01) 00290057 ! 454: COMMON IACN11 (12) 00300057 ! 455: IACN11 (1) = IVON01 00310057 ! 456: IVON02 = 4 00320057 ! 457: IACN11 (2) = IVON02 00330057 ! 458: CALL FS058 (IVON01,IVON02) 00340057 ! 459: IACN11 (11) = IVON01 00350057 ! 460: RETURN 00360057 ! 461: END 00370057 ! 462: C 00010058 ! 463: C DATE***82/08/02*18.33.46 ! 464: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 465: C AUDIT FCVS78 V2.0 ! 466: C COMMENT SECTION 00020058 ! 467: C 00030058 ! 468: C FS058 00040058 ! 469: C 00050058 ! 470: C THIS SUBROUTINE IS CALLED BY SUBROUTINE FS057. THE TWO 00060058 ! 471: C ARGUMENTS PASSED FROM FS057 ALONG WITH A THIRD PARAMETER CREATED 00070058 ! 472: C IN FS058 ARE THEN PASSED TO FUNCTION FF059 WHERE THEY ARE USED IN 00080058 ! 473: C AN ARITHMETIC OPERATION. FS058 THEN SAVES THE RESULT OF THIS 00090058 ! 474: C OPERATION IN THE FIRST ARGUMENT AND RETURNS CONTROL TO FS057 00100058 ! 475: C WITHOUT ANY ADDITIONAL PROCESSING. 00110058 ! 476: C 00120058 ! 477: C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FS057 TO 00130058 ! 478: C FS058 AND RETURNED ARE SAVED IN AN INTEGER ARRAY FOR LATER 00140058 ! 479: C VERIFICATION BY THE MAIN PROGRAM. 00150058 ! 480: C 00160058 ! 481: C REFERENCES 00170058 ! 482: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00180058 ! 483: C X3.9-1978 00190058 ! 484: C 00200058 ! 485: C SECTION 15.5.2, REFERENCING EXTERNAL FUNCTIONS 00210058 ! 486: C SECTION 15.6, SUBROUTINES 00220058 ! 487: C SECTION 15.8, RETURN STATEMENT 00230058 ! 488: C 00240058 ! 489: C TEST SECTION 00250058 ! 490: C 00260058 ! 491: C SUBROUTINE SUBPROGRAM 00270058 ! 492: C 00280058 ! 493: SUBROUTINE FS058 (IVON01,IVON02) 00290058 ! 494: COMMON IACN11 (12) 00300058 ! 495: INTEGER FF059 00310058 ! 496: IVON03 = 3 00320058 ! 497: IACN11 (3) = IVON01 00330058 ! 498: IACN11 (4) = IVON02 00340058 ! 499: IACN11 (5) = IVON03 00350058 ! 500: IVON01 = FF059 (IVON01,IVON02,IVON03) 00360058 ! 501: IACN11 (10) = IVON01 00370058 ! 502: RETURN 00380058 ! 503: END 00390058 ! 504: C 00010059 ! 505: C DATE***82/08/02*18.33.46 ! 506: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 507: C AUDIT FCVS78 V2.0 ! 508: C COMMENT SECTION 00020059 ! 509: C 00030059 ! 510: C FF059 00040059 ! 511: C 00050059 ! 512: C THIS EXTERNAL FUNCTION IS REFERENCED WITHIN SUBROUTINE FS058.00060059 ! 513: C THE THREE ARGUMENTS THAT ARE PASSED ARE SIMPLY ADDED TOGETHER AND 00070059 ! 514: C THE RESULT SUBSTITUTED FOR THE ORIGINAL REFERENCE. CONTROL IS 00080059 ! 515: C THEN RETURNED TO FS058. 00090059 ! 516: C 00100059 ! 517: C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FS058 TO 00110059 ! 518: C FF059 AND THE RESULT THAT IS RETURNED ARE SAVED IN AN INTEGER 00120059 ! 519: C ARRAY FOR LATER VERIFICATION BY THE MAIN PROGRAM. 00130059 ! 520: C 00140059 ! 521: C REFERENCES 00150059 ! 522: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160059 ! 523: C X3.9-1978 00170059 ! 524: C 00180059 ! 525: C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00190059 ! 526: C SECTION 15.8, RETURN STATEMENT 00200059 ! 527: C TEST SECTION 00210059 ! 528: C 00220059 ! 529: C FUNCTION SUBPROGRAM 00230059 ! 530: C 00240059 ! 531: INTEGER FUNCTION FF059 (IVON01,IVON02,IVON03) 00250059 ! 532: COMMON IACN11 (12) 00260059 ! 533: IACN11 (6) = IVON01 00270059 ! 534: IACN11 (7) = IVON02 00280059 ! 535: IACN11 (8) = IVON03 00290059 ! 536: FF059 = IVON01 + IVON02 + IVON03 00300059 ! 537: IACN11 (9) = IVON01 + IVON02 + IVON03 00310059 ! 538: RETURN 00320059 ! 539: END 00330059
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.