![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM050.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 FM050.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 00010050 ! 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 00020050 ! 6: C 00030050 ! 7: C FM050 00040050 ! 8: C 00050050 ! 9: C THIS ROUTINE CONTAINS BASIC SUBROUTINE AND FUNCTION REFERENCE00060050 ! 10: C TESTS. FOUR SUBROUTINES AND ONE FUNCTION ARE CALLED OR 00070050 ! 11: C REFERENCED. FS051 IS CALLED TO TEST THE CALLING AND PASSING OF 00080050 ! 12: C ARGUMENTS THROUGH UNLABELED COMMON. NO ARGUMENTS ARE SPECIFIED 00090050 ! 13: C IN THE CALL LINE. FS052 IS IDENTICAL TO FS051 EXCEPT THAT SEVERAL00100050 ! 14: C RETURNS ARE USED. FS053 UTILIZES MANY ARGUMENTS ON THE CALL 00110050 ! 15: C STATEMENT AND MANY RETURN STATEMENTS IN THE SUBROUTINE BODY. 00120050 ! 16: C FF054 IS A FUNCTION SUBROUTINE IN WHICH MANY ARGUMENTS AND RETURN 00130050 ! 17: C STATEMENTS ARE USED. AND FINALLY FS055 PASSES A ONE DIMENIONAL 00140050 ! 18: C ARRAY BACK TO FM050. 00150050 ! 19: C 00160050 ! 20: C REFERENCES 00170050 ! 21: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00180050 ! 22: C X3.9-1978 00190050 ! 23: C 00200050 ! 24: C SECTION 15.5.2, REFERENCING AN EXTERNAL FUNCTION 00210050 ! 25: C SECTION 15.6.2, SUBROUTINE REFERENCE 00220050 ! 26: C 00230050 ! 27: COMMON RVCN01,IVCN01,IVCN02,IACN11(20) 00240050 ! 28: INTEGER FF054 00250050 ! 29: C 00260050 ! 30: C ********************************************************** 00270050 ! 31: C 00280050 ! 32: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00290050 ! 33: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00300050 ! 34: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00310050 ! 35: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00320050 ! 36: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00330050 ! 37: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00340050 ! 38: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00350050 ! 39: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00360050 ! 40: C OF EXECUTING THESE TESTS. 00370050 ! 41: C 00380050 ! 42: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00390050 ! 43: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00400050 ! 44: C 00410050 ! 45: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00420050 ! 46: C 00430050 ! 47: C DEPARTMENT OF THE NAVY 00440050 ! 48: C FEDERAL COBOL COMPILER TESTING SERVICE 00450050 ! 49: C WASHINGTON, D.C. 20376 00460050 ! 50: C 00470050 ! 51: C ********************************************************** 00480050 ! 52: C 00490050 ! 53: C 00500050 ! 54: C 00510050 ! 55: C INITIALIZATION SECTION 00520050 ! 56: C 00530050 ! 57: C INITIALIZE CONSTANTS 00540050 ! 58: C ************** 00550050 ! 59: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00560050 ! 60: I01 = 5 00570050 ! 61: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00580050 ! 62: I02 = 6 00590050 ! 63: C SYSTEM ENVIRONMENT SECTION 00600050 ! 64: C 00610050 ! 65: I01 = 5 00620050 ! 66: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00630050 ! 67: C (UNIT NUMBER FOR CARD READER). 00640050 ! 68: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00650050 ! 69: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00660050 ! 70: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00670050 ! 71: C 00680050 ! 72: I02 = 6 00690050 ! 73: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00700050 ! 74: C (UNIT NUMBER FOR PRINTER). 00710050 ! 75: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00720050 ! 76: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00730050 ! 77: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00740050 ! 78: C 00750050 ! 79: IVPASS=0 00760050 ! 80: IVFAIL=0 00770050 ! 81: IVDELE=0 00780050 ! 82: ICZERO=0 00790050 ! 83: C 00800050 ! 84: C WRITE PAGE HEADERS 00810050 ! 85: WRITE (I02,90000) 00820050 ! 86: WRITE (I02,90001) 00830050 ! 87: WRITE (I02,90002) 00840050 ! 88: WRITE (I02, 90002) 00850050 ! 89: WRITE (I02,90003) 00860050 ! 90: WRITE (I02,90002) 00870050 ! 91: WRITE (I02,90004) 00880050 ! 92: WRITE (I02,90002) 00890050 ! 93: WRITE (I02,90011) 00900050 ! 94: WRITE (I02,90002) 00910050 ! 95: WRITE (I02,90002) 00920050 ! 96: WRITE (I02,90005) 00930050 ! 97: WRITE (I02,90006) 00940050 ! 98: WRITE (I02,90002) 00950050 ! 99: C TEST SECTION 00960050 ! 100: C 00970050 ! 101: C SUBROUTINE AND FUNCTION SUBPROGRAMS 00980050 ! 102: C 00990050 ! 103: 4001 CONTINUE 01000050 ! 104: IVTNUM = 400 01010050 ! 105: C 01020050 ! 106: C **** TEST 400 **** 01030050 ! 107: C TEST 400 TESTS THE CALL TO A SUBROUTINE CONTAINING NO ARGUMENTS. 01040050 ! 108: C ALL PARAMETERS ARE PASSED THROUGH UNLABELED COMMON. 01050050 ! 109: C 01060050 ! 110: IF (ICZERO) 34000, 4000, 34000 01070050 ! 111: 4000 CONTINUE 01080050 ! 112: RVCN01 = 2.1654 01090050 ! 113: CALL FS051 01100050 ! 114: RVCOMP = RVCN01 01110050 ! 115: GO TO 44000 01120050 ! 116: 34000 IVDELE = IVDELE + 1 01130050 ! 117: WRITE (I02,80003) IVTNUM 01140050 ! 118: IF (ICZERO) 44000, 4011, 44000 01150050 ! 119: 44000 IF (RVCOMP - 3.1649) 24000,14000,44001 01160050 ! 120: 44001 IF (RVCOMP - 3.1659) 14000,14000,24000 01170050 ! 121: 14000 IVPASS = IVPASS + 1 01180050 ! 122: WRITE (I02,80001) IVTNUM 01190050 ! 123: GO TO 4011 01200050 ! 124: 24000 IVFAIL = IVFAIL + 1 01210050 ! 125: RVCORR = 3.1654 01220050 ! 126: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01230050 ! 127: 4011 CONTINUE 01240050 ! 128: C 01250050 ! 129: C TEST 401 THROUGH TEST 403 TEST THE CALL TO SUBROUTINE FS052 WHICH 01260050 ! 130: C CONTAINS NO ARGUMENTS. ALL PARAMETERS ARE PASSED THROUGH 01270050 ! 131: C UNLABELED COMMON. SUBROUTINE FS052 CONTAIN SEVERAL RETURN 01280050 ! 132: C STATEMENTS. 01290050 ! 133: C 01300050 ! 134: IVTNUM = 401 01310050 ! 135: C 01320050 ! 136: C **** TEST 401 **** 01330050 ! 137: C 01340050 ! 138: IF (ICZERO) 34010, 4010, 34010 01350050 ! 139: 4010 CONTINUE 01360050 ! 140: IVCN01 = 5 01370050 ! 141: IVCN02 = 1 01380050 ! 142: CALL FS052 01390050 ! 143: IVCOMP = IVCN01 01400050 ! 144: GO TO 44010 01410050 ! 145: 34010 IVDELE = IVDELE + 1 01420050 ! 146: WRITE (I02,80003) IVTNUM 01430050 ! 147: IF (ICZERO) 44010, 4021, 44010 01440050 ! 148: 44010 IF (IVCOMP - 6) 24010,14010,24010 01450050 ! 149: 14010 IVPASS = IVPASS + 1 01460050 ! 150: WRITE (I02,80001) IVTNUM 01470050 ! 151: GO TO 4021 01480050 ! 152: 24010 IVFAIL = IVFAIL + 1 01490050 ! 153: IVCORR = 6 01500050 ! 154: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01510050 ! 155: 4021 CONTINUE 01520050 ! 156: IVTNUM = 402 01530050 ! 157: C 01540050 ! 158: C **** TEST 402 **** 01550050 ! 159: C 01560050 ! 160: IF (ICZERO) 34020, 4020, 34020 01570050 ! 161: 4020 CONTINUE 01580050 ! 162: IVCN01 = 10 01590050 ! 163: IVCN02 = 5 01600050 ! 164: CALL FS052 01610050 ! 165: IVCOMP = IVCN01 01620050 ! 166: GO TO 44020 01630050 ! 167: 34020 IVDELE = IVDELE + 1 01640050 ! 168: WRITE (I02,80003) IVTNUM 01650050 ! 169: IF (ICZERO) 44020, 4031, 44020 01660050 ! 170: 44020 IF (IVCOMP - 15) 24020,14020,24020 01670050 ! 171: 14020 IVPASS = IVPASS + 1 01680050 ! 172: WRITE (I02,80001) IVTNUM 01690050 ! 173: GO TO 4031 01700050 ! 174: 24020 IVFAIL = IVFAIL + 1 01710050 ! 175: IVCORR = 15 01720050 ! 176: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01730050 ! 177: 4031 CONTINUE 01740050 ! 178: IVTNUM = 403 01750050 ! 179: C 01760050 ! 180: C **** TEST 403 **** 01770050 ! 181: C 01780050 ! 182: IF (ICZERO) 34030, 4030, 34030 01790050 ! 183: 4030 CONTINUE 01800050 ! 184: IVCN01 = 30 01810050 ! 185: IVCN02 = 3 01820050 ! 186: CALL FS052 01830050 ! 187: IVCOMP = IVCN01 01840050 ! 188: GO TO 44030 01850050 ! 189: 34030 IVDELE = IVDELE + 1 01860050 ! 190: WRITE (I02,80003) IVTNUM 01870050 ! 191: IF (ICZERO) 44030, 4041, 44030 01880050 ! 192: 44030 IF (IVCOMP - 33) 24030,14030,24030 01890050 ! 193: 14030 IVPASS = IVPASS + 1 01900050 ! 194: WRITE (I02,80001) IVTNUM 01910050 ! 195: GO TO 4041 01920050 ! 196: 24030 IVFAIL = IVFAIL + 1 01930050 ! 197: IVCORR = 33 01940050 ! 198: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01950050 ! 199: 4041 CONTINUE 01960050 ! 200: C 01970050 ! 201: C TEST 404 THROUGH TEST 406 TEST THE CALL TO SUBROUTINE FS053 WHICH 01980050 ! 202: C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS. 01990050 ! 203: C 02000050 ! 204: IVTNUM = 404 02010050 ! 205: C 02020050 ! 206: C **** TEST 404 **** 02030050 ! 207: C 02040050 ! 208: IF (ICZERO) 34040, 4040, 34040 02050050 ! 209: 4040 CONTINUE 02060050 ! 210: CALL FS053 (6,10,11,IVON04,1) 02070050 ! 211: IVCOMP = IVON04 02080050 ! 212: GO TO 44040 02090050 ! 213: 34040 IVDELE = IVDELE + 1 02100050 ! 214: WRITE (I02,80003) IVTNUM 02110050 ! 215: IF (ICZERO) 44040, 4051, 44040 02120050 ! 216: 44040 IF (IVCOMP - 6) 24040,14040,24040 02130050 ! 217: 14040 IVPASS = IVPASS + 1 02140050 ! 218: WRITE (I02,80001) IVTNUM 02150050 ! 219: GO TO 4051 02160050 ! 220: 24040 IVFAIL = IVFAIL + 1 02170050 ! 221: IVCORR = 6 02180050 ! 222: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02190050 ! 223: 4051 CONTINUE 02200050 ! 224: IVTNUM = 405 02210050 ! 225: C 02220050 ! 226: C **** TEST 405 **** 02230050 ! 227: C 02240050 ! 228: IF (ICZERO) 34050, 4050, 34050 02250050 ! 229: 4050 CONTINUE 02260050 ! 230: IVCN01 = 10 02270050 ! 231: CALL FS053 (6,IVCN01,11,IVON04,2) 02280050 ! 232: IVCOMP = IVON04 02290050 ! 233: GO TO 44050 02300050 ! 234: 34050 IVDELE = IVDELE + 1 02310050 ! 235: WRITE (I02,80003) IVTNUM 02320050 ! 236: IF (ICZERO) 44050, 4061, 44050 02330050 ! 237: 44050 IF (IVCOMP - 16) 24050,14050,24050 02340050 ! 238: 14050 IVPASS = IVPASS + 1 02350050 ! 239: WRITE (I02,80001) IVTNUM 02360050 ! 240: GO TO 4061 02370050 ! 241: 24050 IVFAIL = IVFAIL + 1 02380050 ! 242: IVCORR = 16 02390050 ! 243: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02400050 ! 244: 4061 CONTINUE 02410050 ! 245: IVTNUM = 406 02420050 ! 246: C 02430050 ! 247: C **** TEST 406 **** 02440050 ! 248: C 02450050 ! 249: IF (ICZERO) 34060, 4060, 34060 02460050 ! 250: 4060 CONTINUE 02470050 ! 251: IVON01 = 6 02480050 ! 252: IVON02 = 10 02490050 ! 253: IVON03 = 11 02500050 ! 254: IVON05 = 3 02510050 ! 255: CALL FS053 (IVON01,IVON02,IVON03,IVON04,IVON05) 02520050 ! 256: IVCOMP = IVON04 02530050 ! 257: GO TO 44060 02540050 ! 258: 34060 IVDELE = IVDELE + 1 02550050 ! 259: WRITE (I02,80003) IVTNUM 02560050 ! 260: IF (ICZERO) 44060, 4071, 44060 02570050 ! 261: 44060 IF (IVCOMP - 27) 24060,14060,24060 02580050 ! 262: 14060 IVPASS = IVPASS + 1 02590050 ! 263: WRITE (I02,80001) IVTNUM 02600050 ! 264: GO TO 4071 02610050 ! 265: 24060 IVFAIL = IVFAIL + 1 02620050 ! 266: IVCORR = 27 02630050 ! 267: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02640050 ! 268: 4071 CONTINUE 02650050 ! 269: C 02660050 ! 270: C TEST 407 THROUGH 409 TEST THE REFERENCE TO FUNCTION FF054 WHICH 02670050 ! 271: C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS 02680050 ! 272: C 02690050 ! 273: IVTNUM = 407 02700050 ! 274: C 02710050 ! 275: C **** TEST 407 **** 02720050 ! 276: C 02730050 ! 277: IF (ICZERO) 34070, 4070, 34070 02740050 ! 278: 4070 CONTINUE 02750050 ! 279: IVCOMP = FF054 (300,1,21,1) 02760050 ! 280: GO TO 44070 02770050 ! 281: 34070 IVDELE = IVDELE + 1 02780050 ! 282: WRITE (I02,80003) IVTNUM 02790050 ! 283: IF (ICZERO) 44070, 4081, 44070 02800050 ! 284: 44070 IF (IVCOMP - 300) 24070,14070,24070 02810050 ! 285: 14070 IVPASS = IVPASS + 1 02820050 ! 286: WRITE (I02,80001) IVTNUM 02830050 ! 287: GO TO 4081 02840050 ! 288: 24070 IVFAIL = IVFAIL + 1 02850050 ! 289: IVCORR = 300 02860050 ! 290: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02870050 ! 291: 4081 CONTINUE 02880050 ! 292: IVTNUM = 408 02890050 ! 293: C 02900050 ! 294: C **** TEST 408 **** 02910050 ! 295: C 02920050 ! 296: IF (ICZERO) 34080, 4080, 34080 02930050 ! 297: 4080 CONTINUE 02940050 ! 298: IVON01 = 300 02950050 ! 299: IVON04 = 2 02960050 ! 300: IVCOMP = FF054 (IVON01,77,5,IVON04) 02970050 ! 301: GO TO 44080 02980050 ! 302: 34080 IVDELE = IVDELE + 1 02990050 ! 303: WRITE (I02,80003) IVTNUM 03000050 ! 304: IF (ICZERO) 44080, 4091, 44080 03010050 ! 305: 44080 IF (IVCOMP - 377) 24080,14080,24080 03020050 ! 306: 14080 IVPASS = IVPASS + 1 03030050 ! 307: WRITE (I02,80001) IVTNUM 03040050 ! 308: GO TO 4091 03050050 ! 309: 24080 IVFAIL = IVFAIL + 1 03060050 ! 310: IVCORR = 377 03070050 ! 311: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03080050 ! 312: 4091 CONTINUE 03090050 ! 313: IVTNUM = 409 03100050 ! 314: C 03110050 ! 315: C **** TEST 409 **** 03120050 ! 316: C 03130050 ! 317: IF (ICZERO) 34090, 4090, 34090 03140050 ! 318: 4090 CONTINUE 03150050 ! 319: IVON01 = 71 03160050 ! 320: IVON02 = 21 03170050 ! 321: IVON03 = 17 03180050 ! 322: IVON04 = 3 03190050 ! 323: IVCOMP = FF054 (IVON01,IVON02,IVON03,IVON04) 03200050 ! 324: GO TO 44090 03210050 ! 325: 34090 IVDELE = IVDELE + 1 03220050 ! 326: WRITE (I02,80003) IVTNUM 03230050 ! 327: IF (ICZERO) 44090, 4101, 44090 03240050 ! 328: 44090 IF (IVCOMP - 109) 24090,14090,24090 03250050 ! 329: 14090 IVPASS = IVPASS + 1 03260050 ! 330: WRITE (I02,80001) IVTNUM 03270050 ! 331: GO TO 4101 03280050 ! 332: 24090 IVFAIL = IVFAIL + 1 03290050 ! 333: IVCORR = 109 03300050 ! 334: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03310050 ! 335: 4101 CONTINUE 03320050 ! 336: C 03330050 ! 337: C TEST 410 THROUGH 429 TEST THE CALL TO SUBROUTINE FS055 WHICH 03340050 ! 338: C CONTAINS NO ARGUMENTS. THE PARAMETERS ARE PASSED THROUGH AN 03350050 ! 339: C INTEGER ARRAY VARIABLE IN UNLABELED COMMON. 03360050 ! 340: C 03370050 ! 341: CALL FS055 03380050 ! 342: DO 20 I = 1,20 03390050 ! 343: IF (ICZERO) 34100, 4100, 34100 03400050 ! 344: 4100 CONTINUE 03410050 ! 345: IVTNUM = 409 + I 03420050 ! 346: IVCOMP = IACN11(I) 03430050 ! 347: GO TO 44100 03440050 ! 348: 34100 IVDELE = IVDELE + 1 03450050 ! 349: WRITE (I02,80003) IVTNUM 03460050 ! 350: IF (ICZERO) 44100, 4111, 44100 03470050 ! 351: 44100 IF (IVCOMP - I) 24100,14100,24100 03480050 ! 352: 14100 IVPASS = IVPASS + 1 03490050 ! 353: WRITE (I02,80001) IVTNUM 03500050 ! 354: GO TO 4111 03510050 ! 355: 24100 IVFAIL = IVFAIL + 1 03520050 ! 356: IVCORR = I 03530050 ! 357: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03540050 ! 358: 4111 CONTINUE 03550050 ! 359: 20 CONTINUE 03560050 ! 360: C 03570050 ! 361: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03580050 ! 362: 99999 CONTINUE 03590050 ! 363: WRITE (I02,90002) 03600050 ! 364: WRITE (I02,90006) 03610050 ! 365: WRITE (I02,90002) 03620050 ! 366: WRITE (I02,90002) 03630050 ! 367: WRITE (I02,90007) 03640050 ! 368: WRITE (I02,90002) 03650050 ! 369: WRITE (I02,90008) IVFAIL 03660050 ! 370: WRITE (I02,90009) IVPASS 03670050 ! 371: WRITE (I02,90010) IVDELE 03680050 ! 372: C 03690050 ! 373: C 03700050 ! 374: C TERMINATE ROUTINE EXECUTION 03710050 ! 375: STOP 03720050 ! 376: C 03730050 ! 377: C FORMAT STATEMENTS FOR PAGE HEADERS 03740050 ! 378: 90000 FORMAT (1H1) 03750050 ! 379: 90002 FORMAT (1H ) 03760050 ! 380: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03770050 ! 381: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 03780050 ! 382: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 03790050 ! 383: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 03800050 ! 384: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 03810050 ! 385: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 03820050 ! 386: C 03830050 ! 387: C FORMAT STATEMENTS FOR RUN SUMMARIES 03840050 ! 388: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 03850050 ! 389: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 03860050 ! 390: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 03870050 ! 391: C 03880050 ! 392: C FORMAT STATEMENTS FOR TEST RESULTS 03890050 ! 393: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 03900050 ! 394: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 03910050 ! 395: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 03920050 ! 396: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 03930050 ! 397: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 03940050 ! 398: C 03950050 ! 399: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM050) 03960050 ! 400: END 03970050 ! 401: C 00010051 ! 402: C DATE***82/08/02*18.33.46 ! 403: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 404: C AUDIT FCVS78 V2.0 ! 405: C COMMENT SECTION 00020051 ! 406: C 00030051 ! 407: C FS051 00040051 ! 408: C 00050051 ! 409: C FS051 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060051 ! 410: C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070051 ! 411: C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS051 00080051 ! 412: C INCREMENTS THE VALUE OF A REAL VARIABLE BY 1 AND RETURNS CONTROL 00090051 ! 413: C TO THE CALLING PROGRAM FM050. 00100051 ! 414: C 00110051 ! 415: C REFERENCES 00120051 ! 416: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130051 ! 417: C X3.9-1978 00140051 ! 418: C 00150051 ! 419: C SECTION 15.6, SUBROUTINES 00160051 ! 420: C SECTION 15.8, RETURN STATEMENT 00170051 ! 421: C 00180051 ! 422: C TEST SECTION 00190051 ! 423: C 00200051 ! 424: C SUBROUTINE SUBPROGRAM - NO ARGUMENTS 00210051 ! 425: C 00220051 ! 426: SUBROUTINE FS051 00230051 ! 427: COMMON //RVCN01 00240051 ! 428: RVCN01 = RVCN01 + 1.0 00250051 ! 429: RETURN 00260051 ! 430: END 00270051 ! 431: C 00010052 ! 432: C DATE***82/08/02*18.33.46 ! 433: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 434: C AUDIT FCVS78 V2.0 ! 435: C COMMENT SECTION 00020052 ! 436: C 00030052 ! 437: C FS052 00040052 ! 438: C 00050052 ! 439: C FS052 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060052 ! 440: C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070052 ! 441: C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS052 00080052 ! 442: C INCREMENTS THE VALUE OF ONE INTEGER VARIABLE BY 1,2,3,4 OR 5 00090052 ! 443: C DEPENDING ON THE VALUE OF A SECOND INTEGER VARIABLE AND THEN 00100052 ! 444: C RETURNS CONTROL TO THE CALLING PROGRAM FM050. SEVERAL RETURN 00110052 ! 445: C STATEMENTS ARE INCLUDED. 00120052 ! 446: C 00130052 ! 447: C REFERENCES 00140052 ! 448: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150052 ! 449: C X3.9-1978 00160052 ! 450: C 00170052 ! 451: C SECTION 15.6, SUBROUTINES 00180052 ! 452: C SECTION 15.8, RETURN STATEMENT 00190052 ! 453: C 00200052 ! 454: C TEST SECTION 00210052 ! 455: C 00220052 ! 456: C SUBROUTINE SUBPROGRAM - NO ARGUMENTS, MANY RETURNS 00230052 ! 457: C 00240052 ! 458: SUBROUTINE FS052 00250052 ! 459: COMMON RVDN01,IVCN01,IVCN02 00260052 ! 460: GO TO (10,20,30,40,50),IVCN02 00270052 ! 461: 10 IVCN01 = IVCN01 + 1 00280052 ! 462: RETURN 00290052 ! 463: 20 IVCN01 = IVCN01 + 2 00300052 ! 464: RETURN 00310052 ! 465: 30 IVCN01 = IVCN01 + 3 00320052 ! 466: RETURN 00330052 ! 467: 40 IVCN01 = IVCN01 + 4 00340052 ! 468: RETURN 00350052 ! 469: 50 IVCN01 = IVCN01 + 5 00360052 ! 470: RETURN 00370052 ! 471: END 00380052 ! 472: C 00010053 ! 473: C DATE***82/08/02*18.33.46 ! 474: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 475: C AUDIT FCVS78 V2.0 ! 476: C COMMENT SECTION 00020053 ! 477: C 00030053 ! 478: C FS053 00040053 ! 479: C 00050053 ! 480: C FS053 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060053 ! 481: C PROGRAM FM050. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND 00070053 ! 482: C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE SUBROUTINE FS053 00080053 ! 483: C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS 00090053 ! 484: C DEPENDING ON THE VALUE OF THE FIFTH ARGUMENT. THE RESULTING SUM 00100053 ! 485: C IS THEN RETURNED TO THE CALLING PROGRAM FM050 THROUGH THE FOURTH 00110053 ! 486: C ARGUMENT. 00120053 ! 487: C 00130053 ! 488: C REFERENCES 00140053 ! 489: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150053 ! 490: C X3.9-1978 00160053 ! 491: C 00170053 ! 492: C SECTION 15.6, SUBROUTINES 00180053 ! 493: C SECTION 15.8, RETURN STATEMENT 00190053 ! 494: C 00200053 ! 495: C TEST SECTION 00210053 ! 496: C 00220053 ! 497: C SUBROUTINE SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS 00230053 ! 498: C 00240053 ! 499: SUBROUTINE FS053 (IVON01,IVON02,IVON03,IVON04,IVON05) 00250053 ! 500: GO TO (10,20,30),IVON05 00260053 ! 501: 10 IVON04 = IVON01 00270053 ! 502: RETURN 00280053 ! 503: 20 IVON04 = IVON01 + IVON02 00290053 ! 504: RETURN 00300053 ! 505: 30 IVON04 = IVON01 + IVON02 + IVON03 00310053 ! 506: RETURN 00320053 ! 507: END 00330053 ! 508: C 00010054 ! 509: C DATE***82/08/02*18.33.46 ! 510: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 511: C AUDIT FCVS78 V2.0 ! 512: C COMMENT SECTION 00020054 ! 513: C 00030054 ! 514: C FF054 00040054 ! 515: C 00050054 ! 516: C FF054 IS A FUNCTION SUBPROGRAM WHICH IS REFERENCED BY THE 00060054 ! 517: C MAIN PROGRAM. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND 00070054 ! 518: C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE FUNCTION FF054 00080054 ! 519: C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS 00090054 ! 520: C DEPENDING ON THE VALUE OF THE FOURTH ARGUMENT. THE RESULTING SUM 00100054 ! 521: C IS THEN RETURNED TO THE REFERENCING PROGRAM FM050 THROUGH THE 00110054 ! 522: C FUNCTION REFERENCE. 00120054 ! 523: C 00130054 ! 524: C REFERENCES 00140054 ! 525: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150054 ! 526: C X3.9-1978 00160054 ! 527: C 00170054 ! 528: C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00180054 ! 529: C SECTION 15.8, RETURN STATEMENT 00190054 ! 530: C 00200054 ! 531: C TEST SECTION 00210054 ! 532: C 00220054 ! 533: C FUNCTION SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS 00230054 ! 534: C 00240054 ! 535: INTEGER FUNCTION FF054 (IVON01,IVON02,IVON03,IVON04) 00250054 ! 536: GO TO (10,20,30),IVON04 00260054 ! 537: 10 FF054 = IVON01 00270054 ! 538: RETURN 00280054 ! 539: 20 FF054 = IVON01 + IVON02 00290054 ! 540: RETURN 00300054 ! 541: 30 FF054 = IVON01 + IVON02 + IVON03 00310054 ! 542: RETURN 00320054 ! 543: END 00330054 ! 544: C 00010055 ! 545: C DATE***82/08/02*18.33.46 ! 546: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 547: C AUDIT FCVS78 V2.0 ! 548: C COMMENT SECTION 00020055 ! 549: C 00030055 ! 550: C FS055 00040055 ! 551: C 00050055 ! 552: C FS055 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060055 ! 553: C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070055 ! 554: C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS055 00080055 ! 555: C INITIALIZES A ONE DIMENSIONAL INTEGER ARRAY OF 20 ELEMENTS WITH 00090055 ! 556: C THE VALUES 1 THROUGH 20 RESPECTIVELY. CONTROL IS THEN RETURNED 00100055 ! 557: C TO THE CALLING PROGRAM FM050. 00110055 ! 558: C 00120055 ! 559: C REFERENCES 00130055 ! 560: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140055 ! 561: C X3.9-1978 00150055 ! 562: C 00160055 ! 563: C SECTION 15.6, SUBROUTINES 00170055 ! 564: C SECTION 15.8, RETURN STATEMENT 00180055 ! 565: C 00190055 ! 566: C TEST SECTION 00200055 ! 567: C 00210055 ! 568: C SUBROUTINE SUBPROGRAM - ARRAY ARGUMENTS 00220055 ! 569: C 00230055 ! 570: SUBROUTINE FS055 00240055 ! 571: COMMON RVCN01,IVCN01,IVCN02,IACN11 00250055 ! 572: DIMENSION IACN11(20) 00260055 ! 573: DO 20 I = 1,20 00270055 ! 574: IACN11(I) = I 00280055 ! 575: 20 CONTINUE 00290055 ! 576: RETURN 00300055 ! 577: END 00310055
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.