![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM080.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 FM080.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 COMMENT SECTION 00010080 ! 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 00020080 ! 6: C FM080 00030080 ! 7: C 00040080 ! 8: C THIS ROUTINE CONTAINS EXTERNAL FUNCTION REFERENCE TESTS. 00050080 ! 9: C THE FUNCTION SUBPROGRAMS CALLED BY THIS ROUTINE ARE FF081, 00060080 ! 10: C FF082 AND FF083. THE FUNCTION SUBPROGRAMS ARE DEFINED AS 00070080 ! 11: C FF081 = INTEGER, FF082 = REAL, FF083 = IMPLICIT REAL. 00080080 ! 12: C THE FUNCTION SUBPROGRAM DUMMY ARGUMENTS MUST AGREE IN ORDER, 00090080 ! 13: C NUMBER AND TYPE WITH THE CORRESPONDING ACTUAL ARGUMENTS OF THE 00100080 ! 14: C MAIN PROGRAM. THE ARGUMENTS OF THE FUNCTION SUBPROGRAMS WILL 00110080 ! 15: C CORRESPOND TO ACTUAL ARGUMENT LIST REFERENCES OF VARIABLE-NAME, 00120080 ! 16: C ARRAY-NAME, ARRAY-ELEMENT-NAME AND EXPRESSION RESPECTIVELY. 00130080 ! 17: C 00140080 ! 18: C THIS ROUTINE WILL TEST THE VALUE OF THE FUNCTION AND THE 00150080 ! 19: C FUNCTION ARGUMENTS RETURNED FOLLOWING THE FUNCTION REFERENCE CALL.00160080 ! 20: C 00170080 ! 21: C 00180080 ! 22: C REFERENCES 00190080 ! 23: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00200080 ! 24: C X3.9-1978 00210080 ! 25: C 00220080 ! 26: C SECTION 2.6, ARRAY 00230080 ! 27: C SECTION 15.5.2, REFERENCING EXTERNAL FUNCTIONS 00240080 ! 28: C SECTION 17.2, EVENTS THAT CAUSE ENTITIES TO BECOME DEFINED 00250080 ! 29: DIMENSION IADN1A (5), IADN2A (4,4) 00260080 ! 30: DIMENSION RADN3A (3,6,3), RADN1A (10) 00270080 ! 31: DIMENSION IADN3A (3,4,5) 00280080 ! 32: INTEGER FF081 00290080 ! 33: REAL FF082 00300080 ! 34: C 00310080 ! 35: C ********************************************************** 00320080 ! 36: C 00330080 ! 37: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00340080 ! 38: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00350080 ! 39: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00360080 ! 40: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00370080 ! 41: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00380080 ! 42: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00390080 ! 43: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00400080 ! 44: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00410080 ! 45: C OF EXECUTING THESE TESTS. 00420080 ! 46: C 00430080 ! 47: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00440080 ! 48: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00450080 ! 49: C 00460080 ! 50: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00470080 ! 51: C 00480080 ! 52: C DEPARTMENT OF THE NAVY 00490080 ! 53: C FEDERAL COBOL COMPILER TESTING SERVICE 00500080 ! 54: C WASHINGTON, D.C. 20376 00510080 ! 55: C 00520080 ! 56: C ********************************************************** 00530080 ! 57: C 00540080 ! 58: C 00550080 ! 59: C 00560080 ! 60: C INITIALIZATION SECTION 00570080 ! 61: C 00580080 ! 62: C INITIALIZE CONSTANTS 00590080 ! 63: C ************** 00600080 ! 64: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00610080 ! 65: I01 = 5 00620080 ! 66: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00630080 ! 67: I02 = 6 00640080 ! 68: C SYSTEM ENVIRONMENT SECTION 00650080 ! 69: C 00660080 ! 70: I01 = 5 00670080 ! 71: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680080 ! 72: C (UNIT NUMBER FOR CARD READER). 00690080 ! 73: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00700080 ! 74: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00710080 ! 75: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00720080 ! 76: C 00730080 ! 77: I02 = 6 00740080 ! 78: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00750080 ! 79: C (UNIT NUMBER FOR PRINTER). 00760080 ! 80: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00770080 ! 81: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00780080 ! 82: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00790080 ! 83: C 00800080 ! 84: IVPASS=0 00810080 ! 85: IVFAIL=0 00820080 ! 86: IVDELE=0 00830080 ! 87: ICZERO=0 00840080 ! 88: C 00850080 ! 89: C WRITE PAGE HEADERS 00860080 ! 90: WRITE (I02,90000) 00870080 ! 91: WRITE (I02,90001) 00880080 ! 92: WRITE (I02,90002) 00890080 ! 93: WRITE (I02, 90002) 00900080 ! 94: WRITE (I02,90003) 00910080 ! 95: WRITE (I02,90002) 00920080 ! 96: WRITE (I02,90004) 00930080 ! 97: WRITE (I02,90002) 00940080 ! 98: WRITE (I02,90011) 00950080 ! 99: WRITE (I02,90002) 00960080 ! 100: WRITE (I02,90002) 00970080 ! 101: WRITE (I02,90005) 00980080 ! 102: WRITE (I02,90006) 00990080 ! 103: WRITE (I02,90002) 01000080 ! 104: C 01010080 ! 105: C TEST SECTION 01020080 ! 106: C 01030080 ! 107: C EXTERNAL FUNCTION REFERENCE - FUNCTION SUBPROGRAM DEFINED AS 01040080 ! 108: C INTEGER (FF081) 01050080 ! 109: C 01060080 ! 110: 6741 CONTINUE 01070080 ! 111: IVTNUM = 674 01080080 ! 112: C 01090080 ! 113: C TEST 674 THROUGH 679 TEST THE FUNCTION AND ARGUMENT VALUES 01100080 ! 114: C FROM REFERENCE OF FUNCTION FF081. FUNCTION SUBPROGRAM FF081 IS 01110080 ! 115: C DEFINED AS INTEGER. 01120080 ! 116: C 01130080 ! 117: C **** TEST 674 **** 01140080 ! 118: C 01150080 ! 119: C TEST 674 TESTS THE FUNCTION VALUE RETURNED FROM FUNCTION FF081 01160080 ! 120: C 01170080 ! 121: IF (ICZERO) 36740,6740,36740 01180080 ! 122: 6740 CONTINUE 01190080 ! 123: IVON0A = 0 01200080 ! 124: IVON02 = 2 01210080 ! 125: IADN1A (3) = 8 01220080 ! 126: IADN1A (2) = 4 01230080 ! 127: IADN2A (1,3) =10 01240080 ! 128: IVON0A = FF081 (IVON02, IADN1A, IADN2A, 999) 01250080 ! 129: GO TO 46740 01260080 ! 130: 36740 IVDELE = IVDELE + 1 01270080 ! 131: WRITE (I02,80003) IVTNUM 01280080 ! 132: IF (ICZERO) 46740,6751,46740 01290080 ! 133: 46740 IF (IVON0A - 1015) 26740,16740,26740 01300080 ! 134: 16740 IVPASS = IVPASS + 1 01310080 ! 135: WRITE (I02,80001) IVTNUM 01320080 ! 136: GO TO 6751 01330080 ! 137: 26740 IVFAIL = IVFAIL + 1 01340080 ! 138: IVCORR = 1015 01350080 ! 139: IVCOMP = IVON0A 01360080 ! 140: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01370080 ! 141: 6751 CONTINUE 01380080 ! 142: IVTNUM = 675 01390080 ! 143: C 01400080 ! 144: C **** TEST 675 **** 01410080 ! 145: C 01420080 ! 146: C TEST 675 TESTS THE RETURN VALUE OF VARIABLE-NAME ARGUMENT 01430080 ! 147: C IVON02. VALUE OF IVON02 SHOULD BE 4. 01440080 ! 148: C 01450080 ! 149: IF (ICZERO) 36750,6750,36750 01460080 ! 150: 6750 CONTINUE 01470080 ! 151: GO TO 46750 01480080 ! 152: 36750 IVDELE = IVDELE + 1 01490080 ! 153: WRITE (I02,80003) IVTNUM 01500080 ! 154: IF (ICZERO) 46750,6761,46750 01510080 ! 155: 46750 IF (IVON02 - 4) 26750,16750,26750 01520080 ! 156: 16750 IVPASS = IVPASS + 1 01530080 ! 157: WRITE (I02,80001) IVTNUM 01540080 ! 158: GO TO 6761 01550080 ! 159: 26750 IVFAIL = IVFAIL + 1 01560080 ! 160: IVCORR = 4 01570080 ! 161: IVCOMP = IVON02 01580080 ! 162: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01590080 ! 163: 6761 CONTINUE 01600080 ! 164: IVTNUM = 676 01610080 ! 165: C 01620080 ! 166: C **** TEST 676 **** 01630080 ! 167: C 01640080 ! 168: C TEST 676 TESTS THE RETURN VALUE OF ARRAY-NAME ARGUMENT 01650080 ! 169: C IADN1A. IADN1A (2) IS INCREMENTED BY 40 IN FUNCTION SUBPROGRAM 01660080 ! 170: C AND SHOULD RETURN A VALUE OF 44. 01670080 ! 171: C 01680080 ! 172: IF (ICZERO) 36760,6760,36760 01690080 ! 173: 6760 CONTINUE 01700080 ! 174: GO TO 46760 01710080 ! 175: 36760 IVDELE = IVDELE + 1 01720080 ! 176: WRITE (I02,80003) IVTNUM 01730080 ! 177: IF (ICZERO) 46760,6771,46760 01740080 ! 178: 46760 IF (IADN1A (2) - 44) 26760,16760,26760 01750080 ! 179: 16760 IVPASS = IVPASS + 1 01760080 ! 180: WRITE (I02,80001) IVTNUM 01770080 ! 181: GO TO 6771 01780080 ! 182: 26760 IVFAIL = IVFAIL + 1 01790080 ! 183: IVCORR = 44 01800080 ! 184: IVCOMP = IADN1A (2) 01810080 ! 185: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01820080 ! 186: 6771 CONTINUE 01830080 ! 187: IVTNUM = 677 01840080 ! 188: C 01850080 ! 189: C **** TEST 677 **** 01860080 ! 190: C 01870080 ! 191: C TEST 677 TESTS THE RETURN VALUE OF ARRAY-NAME ARGUMENT IADN1A. 01880080 ! 192: C IADN1A (3) WAS NOT MODIFFED BY FUNCTION SUBPROGRAM AND SHOULD 01890080 ! 193: C HAVE A VALUE OF 8 01900080 ! 194: C 01910080 ! 195: IF (ICZERO) 36770,6770,36770 01920080 ! 196: 6770 CONTINUE 01930080 ! 197: GO TO 46770 01940080 ! 198: 36770 IVDELE = IVDELE + 1 01950080 ! 199: WRITE (I02,80003) IVTNUM 01960080 ! 200: IF (ICZERO) 46770,6781,46770 01970080 ! 201: 46770 IF (IADN1A (3) - 8) 26770,16770,26770 01980080 ! 202: 16770 IVPASS = IVPASS + 1 01990080 ! 203: WRITE (I02,80001) IVTNUM 02000080 ! 204: GO TO 6781 02010080 ! 205: 26770 IVFAIL = IVFAIL + 1 02020080 ! 206: IVCORR = 8 02030080 ! 207: IVCOMP = IADN1A (3) 02040080 ! 208: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02050080 ! 209: 6781 CONTINUE 02060080 ! 210: IVTNUM = 678 02070080 ! 211: C 02080080 ! 212: C **** TEST 678 **** 02090080 ! 213: C 02100080 ! 214: C TEST 678 TESTS THE RETURN VALUE OF ARRAY-ELEMENT-NAME 02110080 ! 215: C IADN2A (1,3). IADN2A (1,3) WAS INCREMENTED BY 70 IN THE FUNCTION 02120080 ! 216: C SUBPROGRAM AND SHOULD CONTAIN A VALUE OF 80. 02130080 ! 217: C 02140080 ! 218: IF (ICZERO) 36780,6780,36780 02150080 ! 219: 6780 CONTINUE 02160080 ! 220: GO TO 46780 02170080 ! 221: 36780 IVDELE = IVDELE + 1 02180080 ! 222: WRITE (I02,80003) IVTNUM 02190080 ! 223: IF (ICZERO) 46780,6791,46780 02200080 ! 224: 46780 IF (IADN2A (1,3) - 80) 26780,16780,26780 02210080 ! 225: 16780 IVPASS = IVPASS + 1 02220080 ! 226: WRITE (I02,80001) IVTNUM 02230080 ! 227: GO TO 6791 02240080 ! 228: 26780 IVFAIL = IVFAIL + 1 02250080 ! 229: IVCORR = 80 02260080 ! 230: IVCOMP = IADN2A (1,3) 02270080 ! 231: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02280080 ! 232: 6791 CONTINUE 02290080 ! 233: IVTNUM = 679 02300080 ! 234: C 02310080 ! 235: C **** TEST 679 **** 02320080 ! 236: C 02330080 ! 237: C TEST 679 TESTS THE VALUE OF INTEGER FUNCTION ASSIGNED 02340080 ! 238: C TO A REAL VARIABLE. 02350080 ! 239: C 02360080 ! 240: IF (ICZERO) 36790,6790,36790 02370080 ! 241: 6790 CONTINUE 02380080 ! 242: RVON0A = 0.0 02390080 ! 243: IVON02 = 2 02400080 ! 244: IADN1A (2) = 4 02410080 ! 245: IADN2A (1,3) = 10 02420080 ! 246: RVON0A = FF081 (IVON02, IADN1A, IADN2A, 999) 02430080 ! 247: GO TO 46790 02440080 ! 248: 36790 IVDELE = IVDELE + 1 02450080 ! 249: WRITE (I02,80003) IVTNUM 02460080 ! 250: IF (ICZERO) 46790,6801,46790 02470080 ! 251: 46790 IF (RVON0A - 1014.5) 26790,16790,46791 02480080 ! 252: 46791 IF (RVON0A - 1015.5) 16790,16790,26790 02490080 ! 253: 16790 IVPASS = IVPASS + 1 02500080 ! 254: WRITE (I02,80001) IVTNUM 02510080 ! 255: GO TO 6801 02520080 ! 256: 26790 IVFAIL = IVFAIL + 1 02530080 ! 257: RVCORR = 1015.0 02540080 ! 258: RVCOMP = RVON0A 02550080 ! 259: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02560080 ! 260: 6801 CONTINUE 02570080 ! 261: IVTNUM = 680 02580080 ! 262: C 02590080 ! 263: C EXTERNAL FUNCTION REFERENCE - FUNCTION SUBPROGRAM FF082 DEFINED AS02600080 ! 264: C REAL 02610080 ! 265: C 02620080 ! 266: C TESTS 680 THRU 685 TESTS THE FUNCTION AND ARGUMENT VALUES 02630080 ! 267: C FROM THE FUNCTION REFERENCE TO SUBPROGRAM FF082. THE FUNCTION 02640080 ! 268: C SUBPROGRAM IS DEFINED AS REAL. 02650080 ! 269: C 02660080 ! 270: C **** TEST 680 *** 02670080 ! 271: C 02680080 ! 272: C TEST 680 TESTS THE VALUE OF THE FUNCTION FF082. VALUE OF 02690080 ! 273: C FUNCTION SHOULD BE 339.0. 02700080 ! 274: C 02710080 ! 275: IF (ICZERO) 36800,6800,36800 02720080 ! 276: 6800 CONTINUE 02730080 ! 277: RVON01 = 2.0 02740080 ! 278: RADN3A (2,5,2) = 100.0 02750080 ! 279: RADN1A (5) = 210.5 02760080 ! 280: RVON0A = 0.0 02770080 ! 281: RVON0A = FF082 (RVON01, RADN3A, RADN1A, 26.5) 02780080 ! 282: GO TO 46800 02790080 ! 283: 36800 IVDELE = IVDELE + 1 02800080 ! 284: WRITE (I02, 80003) IVTNUM 02810080 ! 285: IF (ICZERO) 46800,6811,46800 02820080 ! 286: 46800 IF (RVON0A - 338.5) 26800,16800,46801 02830080 ! 287: 46801 IF (RVON0A - 339.5) 16800,16800,26800 02840080 ! 288: 16800 IVPASS = IVPASS + 1 02850080 ! 289: WRITE (I02,80001) IVTNUM 02860080 ! 290: GO TO 6811 02870080 ! 291: 26800 IVFAIL = IVFAIL + 1 02880080 ! 292: RVCORR = 339.0 02890080 ! 293: RVCOMP = RVON0A 02900080 ! 294: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02910080 ! 295: 6811 CONTINUE 02920080 ! 296: IVTNUM = 681 02930080 ! 297: C 02940080 ! 298: C **** TEST 681 **** 02950080 ! 299: C 02960080 ! 300: C TEST 681 TESTS THE VALUE OF THE VARIABLE-NAME ARGUMENT RVON01 02970080 ! 301: C FOLLOWING THE FUNCTION REFERENCE. VALUE OF RVON01 SHOULD BE 8.4. 02980080 ! 302: C 02990080 ! 303: IF (ICZERO) 36810,6810,36810 03000080 ! 304: 6810 CONTINUE 03010080 ! 305: GO TO 46810 03020080 ! 306: 36810 IVDELE = IVDELE + 1 03030080 ! 307: WRITE (I02,80003) IVTNUM 03040080 ! 308: IF (ICZERO) 46810,6821,46810 03050080 ! 309: 46810 IF (RVON01 - 8.395) 26810,16810,46811 03060080 ! 310: 46811 IF (RVON01 - 8.405) 16810,16810,26810 03070080 ! 311: 16810 IVPASS = IVPASS + 1 03080080 ! 312: WRITE (I02,80001) IVTNUM 03090080 ! 313: GO TO 6821 03100080 ! 314: 26810 IVFAIL = IVFAIL + 1 03110080 ! 315: RVCORR = 8.4 03120080 ! 316: RVCOMP = RVON01 03130080 ! 317: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03140080 ! 318: 6821 CONTINUE 03150080 ! 319: IVTNUM = 682 03160080 ! 320: C 03170080 ! 321: C **** TEST 682 **** 03180080 ! 322: C 03190080 ! 323: C TEST 682 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT RADN3A 03200080 ! 324: C FOLLOWING THE FUNCTION REFERENCE. RADN3A (2,5,2) WAS INITIALIZED 03210080 ! 325: C IN MAIN PROGRAM AND INCREMENTED IN SUBPROGRAM. VALUE OF RADN3A 03220080 ! 326: C (2,5,2) SHOULD BE 112.2. 03230080 ! 327: C 03240080 ! 328: IF (ICZERO) 36820,6820,36820 03250080 ! 329: 6820 CONTINUE 03260080 ! 330: GO TO 46820 03270080 ! 331: 36820 IVDELE = IVDELE + 1 03280080 ! 332: WRITE (I02,80003) IVTNUM 03290080 ! 333: IF (ICZERO) 46820,6831,46820 03300080 ! 334: 46820 IF (RADN3A (2,5,2) - 111.7) 26820,16820,46821 03310080 ! 335: 46821 IF (RADN3A (2,5,2) - 112.7) 16820,16820,26820 03320080 ! 336: 16820 IVPASS = IVPASS + 1 03330080 ! 337: WRITE (I02,80001) IVTNUM 03340080 ! 338: GO TO 6831 03350080 ! 339: 26820 IVFAIL = IVFAIL + 1 03360080 ! 340: RVCORR = 112.2 03370080 ! 341: RVCOMP = RADN3A (2,5,2) 03380080 ! 342: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03390080 ! 343: 6831 CONTINUE 03400080 ! 344: IVTNUM = 683 03410080 ! 345: C 03420080 ! 346: C **** TEST 683 **** 03430080 ! 347: C 03440080 ! 348: C TEST 683 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT RADN3A 03450080 ! 349: C FOLLOWING THE FUNCTION REFERENCE. RADN3A (1,2,1) WAS INITIALIZED 03460080 ! 350: C IN THE SUBPROGRAM. THE VALUE OF RADN3A (1,2,1) SHOULD BE 612.2. 03470080 ! 351: C 03480080 ! 352: IF (ICZERO) 36830,6830,36830 03490080 ! 353: 6830 CONTINUE 03500080 ! 354: GO TO 46830 03510080 ! 355: 36830 IVDELE = IVDELE + 1 03520080 ! 356: WRITE (I02,80003) IVTNUM 03530080 ! 357: IF (ICZERO) 46830,6841,46830 03540080 ! 358: 46830 IF (RADN3A (1,2,1) - 611.7) 26830,16830,46831 03550080 ! 359: 46831 IF (RADN3A (1,2,1) - 612.7) 16830,16830,26830 03560080 ! 360: 16830 IVPASS = IVPASS + 1 03570080 ! 361: WRITE (I02,80001) IVTNUM 03580080 ! 362: GO TO 6841 03590080 ! 363: 26830 IVFAIL = IVFAIL + 1 03600080 ! 364: RVCORR = 612.2 03610080 ! 365: RVCOMP = RADN3A (1,2,1) 03620080 ! 366: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03630080 ! 367: 6841 CONTINUE 03640080 ! 368: IVTNUM = 684 03650080 ! 369: C 03660080 ! 370: C **** TEST 684 **** 03670080 ! 371: C 03680080 ! 372: C TEST 684 TESTS THE VALUE OF THE ARRAY-ELEMENT-NAME ARGUMENT 03690080 ! 373: C RADN1A FOLLOWING THE FUNCTION REFERENCE. RADN1A (5) WAS 03700080 ! 374: C INITIALIZED IN THE MAIN PROGRAM AND INCREMENTED BY 18.8 IN THE 03710080 ! 375: C FUNCTION SUBPROGRAM. THE VALUE OF RADN1A SHOULD BE 229.3. 03720080 ! 376: C 03730080 ! 377: IF (ICZERO) 36840,6840,36840 03740080 ! 378: 6840 CONTINUE 03750080 ! 379: GO TO 46840 03760080 ! 380: 36840 IVDELE = IVDELE + 1 03770080 ! 381: WRITE (I02,80003) IVTNUM 03780080 ! 382: IF (ICZERO) 46840,6851,46840 03790080 ! 383: 46840 IF (RADN1A (5) - 228.8) 26840,16840,46841 03800080 ! 384: 46841 IF (RADN1A (5) - 229.8) 16840,16840,26840 03810080 ! 385: 16840 IVPASS = IVPASS + 1 03820080 ! 386: WRITE (I02,80001) IVTNUM 03830080 ! 387: GO TO 6851 03840080 ! 388: 26840 IVFAIL = IVFAIL + 1 03850080 ! 389: RVCORR = 229.3 03860080 ! 390: RVCOMP = RADN1A (5) 03870080 ! 391: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03880080 ! 392: 6851 CONTINUE 03890080 ! 393: IVTNUM = 685 03900080 ! 394: C 03910080 ! 395: C **** TEST 685 **** 03920080 ! 396: C 03930080 ! 397: C TEST 685 TESTS THE RESULTANT VALUE WHERE THE FUNCTION 03940080 ! 398: C SUBPROGRAM IS DEFINED AS REAL AND THE VARIABLE TO WHICH THE 03950080 ! 399: C FUNCTION VALUE IS ASSIGNED IN THE MAIN PROGRAM IS DEFINED AS 03960080 ! 400: C INTEGER. 03970080 ! 401: C 03980080 ! 402: IF (ICZERO) 36850,6850,36850 03990080 ! 403: 6850 CONTINUE 04000080 ! 404: RVON01 = 4.0 04010080 ! 405: RADN3A (2,5,2) = 200.0 04020080 ! 406: RADN1A (5) = 2.85 04030080 ! 407: IVON0A = 0.0 04040080 ! 408: IVON0A = FF082 (RVON01, RADN3A, RADN1A, 102.68) 04050080 ! 409: GO TO 46850 04060080 ! 410: 36850 IVDELE = IVDELE + 1 04070080 ! 411: WRITE (I02,80003) IVTNUM 04080080 ! 412: IF (ICZERO) 46850,6861,46850 04090080 ! 413: 46850 IF (IVON0A - 309) 26850,16850,26850 04100080 ! 414: 16850 IVPASS = IVPASS + 1 04110080 ! 415: WRITE (I02,80001) IVTNUM 04120080 ! 416: GO TO 6861 04130080 ! 417: 26850 IVFAIL = IVFAIL + 1 04140080 ! 418: IVCORR = 309 04150080 ! 419: IVCOMP = IVON0A 04160080 ! 420: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04170080 ! 421: 6861 CONTINUE 04180080 ! 422: IVTNUM = 686 04190080 ! 423: C 04200080 ! 424: C TESTS 686 THRU 690 TESTS THE FUNCTION AND ARGUMENT VALUES 04210080 ! 425: C FROM THE EXTERNAL FUNCTION REFERENCE TO SUBPROGRAM FF083. THE 04220080 ! 426: C FUNCTION SUBPROGRAM IS AN IMPLICIT DEFINITION OF REAL. 04230080 ! 427: C 04240080 ! 428: C ***** TEST 686 ***** 04250080 ! 429: C 04260080 ! 430: C TEST 686 TESTS THE VALUE OF FUNCTION FF082. THE VALUE OF THE 04270080 ! 431: C FUNCTION SHOULD BE 921.8. 04280080 ! 432: C 04290080 ! 433: IF (ICZERO) 36860,6860,36860 04300080 ! 434: 6860 CONTINUE 04310080 ! 435: C 04320080 ! 436: C 04330080 ! 437: IVON01 = 826 04340080 ! 438: IADN2A (1,1) = 77 04350080 ! 439: IADN3A (2,3,4) = 10 04360080 ! 440: RVON02 = 4.4 04370080 ! 441: RVON03 = 0.0 04380080 ! 442: C 04390080 ! 443: RVON03 = FF083 (IVON01, IADN2A, IADN3A, RVON02 * 2.0) 04400080 ! 444: GO TO 46860 04410080 ! 445: 36860 IVDELE = IVDELE + 1 04420080 ! 446: WRITE (I02,80003) IVTNUM 04430080 ! 447: IF (ICZERO) 46860,6871,46860 04440080 ! 448: 46860 IF (RVON03 - 921.3) 26860,16860,46861 04450080 ! 449: 46861 IF (RVON03 - 922.3) 16860,16860,26860 04460080 ! 450: 16860 IVPASS = IVPASS + 1 04470080 ! 451: WRITE (I02,80001) IVTNUM 04480080 ! 452: GO TO 6871 04490080 ! 453: 26860 IVFAIL = IVFAIL + 1 04500080 ! 454: RVCORR = 921.8 04510080 ! 455: RVCOMP = RVON03 04520080 ! 456: WRITE (I02,80005) IVTNUM, RVCOMP, IVCORR 04530080 ! 457: 6871 CONTINUE 04540080 ! 458: IVTNUM = 687 04550080 ! 459: C 04560080 ! 460: C **** TEST 687 ***** 04570080 ! 461: C 04580080 ! 462: C TEST 687 TESTS THE VALUE OF THE VARIABLE-NAME ARGUMENT IVON01 04590080 ! 463: C FOLLOWING THE FUNCTION REFERENCE. THE VALUE OF IVON01 SHOULD BE 04600080 ! 464: C 836. 04610080 ! 465: C 04620080 ! 466: IF (ICZERO) 36870,6870,36870 04630080 ! 467: 6870 CONTINUE 04640080 ! 468: GO TO 46870 04650080 ! 469: 36870 IVDELE = IVDELE + 1 04660080 ! 470: WRITE (I02,80003) IVTNUM 04670080 ! 471: IF (ICZERO) 46870,6881,46870 04680080 ! 472: 46870 IF (IVON01 - 836) 26870,16870,26870 04690080 ! 473: 16870 IVPASS = IVPASS + 1 04700080 ! 474: WRITE (I02,80001) IVTNUM 04710080 ! 475: GO TO 6881 04720080 ! 476: 26870 IVFAIL = IVFAIL + 1 04730080 ! 477: IVCORR = 836 04740080 ! 478: IVCOMP = IVON01 04750080 ! 479: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04760080 ! 480: 6881 CONTINUE 04770080 ! 481: IVTNUM = 688 04780080 ! 482: C 04790080 ! 483: C **** TEST 688 ***** 04800080 ! 484: C 04810080 ! 485: C TEST 688 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT IADN2A 04820080 ! 486: C FOLLOWING THE FUNCTION REFERENCE. THE ACTUAL ARGUMENT WAS 04830080 ! 487: C INITIALIZED IN THE MAIN PROGRAM AND IS INCREMENTED IN THE 04840080 ! 488: C SUBPROGRAM. THE VALUE OF IADN2A (1,1) SHOULD BE 97. 04850080 ! 489: C 04860080 ! 490: IF (ICZERO) 36880,6880,36880 04870080 ! 491: 6880 CONTINUE 04880080 ! 492: GO TO 46880 04890080 ! 493: 36880 IVDELE = IVDELE + 1 04900080 ! 494: WRITE (I02,80003) IVTNUM 04910080 ! 495: IF (ICZERO) 46880,6880,46880 04920080 ! 496: 46880 IF (IADN2A (1,1) - 97) 26880,16880,26880 04930080 ! 497: 16880 IVPASS = IVPASS + 1 04940080 ! 498: WRITE (I02,80001) IVTNUM 04950080 ! 499: GO TO 6891 04960080 ! 500: 26880 IVFAIL = IVFAIL + 1 04970080 ! 501: IVCORR = 97 04980080 ! 502: IVCOMP = IADN2A (1,1) 04990080 ! 503: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05000080 ! 504: 6891 CONTINUE 05010080 ! 505: IVTNUM = 689 05020080 ! 506: C 05030080 ! 507: C **** TEST 689 **** 05040080 ! 508: C 05050080 ! 509: C TEST 689 TESTS THE VALUE OF THE ARRAY-ELEMENT-NAME ARGUMENT 05060080 ! 510: C IADN3A FOLLOWING THE FUNCTION REFERENCE. IADN3A (2,3,4) 05070080 ! 511: C WAS INTIALIZED IN THE MAIN PROGRAM AND INCREMENTED BY 40 IN THE 05080080 ! 512: C FUNCTION SUBPROGRAM. THE VALUE OF IADN3A SHOULD BE 50. 05090080 ! 513: C 05100080 ! 514: IF (ICZERO) 36890,6890,36890 05110080 ! 515: 6890 CONTINUE 05120080 ! 516: GO TO 46890 05130080 ! 517: 36890 IVDELE = IVDELE + 1 05140080 ! 518: WRITE (I02,80003) IVTNUM 05150080 ! 519: IF (ICZERO) 46890,6901,46890 05160080 ! 520: 46890 IF (IADN3A (2,3,4) - 50) 26890,16890,26890 05170080 ! 521: 16890 IVPASS = IVPASS + 1 05180080 ! 522: WRITE (I02,80001) IVTNUM 05190080 ! 523: GO TO 6901 05200080 ! 524: 26890 IVFAIL = IVFAIL + 1 05210080 ! 525: IVCORR = 50 05220080 ! 526: IVCOMP = IADN3A (2,3,4) 05230080 ! 527: WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 05240080 ! 528: 6901 CONTINUE 05250080 ! 529: IVTNUM = 690 05260080 ! 530: C 05270080 ! 531: C **** TEST 690 **** 05280080 ! 532: C 05290080 ! 533: C TEST 690 TESTS THE RESULTANT VALUE WHERE THE FUNCTION 05300080 ! 534: C SUBPROGRAM IS IMPLICITY DEFINED AS REAL AND THE VARIABLE 05310080 ! 535: C TO WHICH THE FUNCTION VALUE IS ASSIGNED IN THE MAIN PROGRAM 05320080 ! 536: C IS DEFINED AS INTEGER. THE VALUE OF IVON03 SHOULD BE 329. 05330080 ! 537: C 05340080 ! 538: IF (ICZERO) 36900,6900,36900 05350080 ! 539: 6900 CONTINUE 05360080 ! 540: IVON01 = 226 05370080 ! 541: IADN2A (1,1) = 66 05380080 ! 542: IADN3A (2,3,4) = 20 05390080 ! 543: RVON02 = 8.8 05400080 ! 544: IVON03 = 0 05410080 ! 545: C 05420080 ! 546: IVON03 = FF083 (IVON01,IADN2A,IADN3A,RVON02 * 2.0) 05430080 ! 547: C 05440080 ! 548: GO TO 46900 05450080 ! 549: 36900 IVDELE = IVDELE + 1 05460080 ! 550: WRITE (I02,80003) IVTNUM 05470080 ! 551: IF (ICZERO) 46900,6911,46900 05480080 ! 552: 46900 IF (IVON03 - 329) 26900,16900,26900 05490080 ! 553: 16900 IVPASS = IVPASS + 1 05500080 ! 554: WRITE (I02,80001) IVTNUM 05510080 ! 555: GO TO 6911 05520080 ! 556: 26900 IVFAIL = IVFAIL + 1 05530080 ! 557: IVCORR = 329 05540080 ! 558: IVCOMP = IVON03 05550080 ! 559: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05560080 ! 560: 6911 CONTINUE 05570080 ! 561: C 05580080 ! 562: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 05590080 ! 563: 99999 CONTINUE 05600080 ! 564: WRITE (I02,90002) 05610080 ! 565: WRITE (I02,90006) 05620080 ! 566: WRITE (I02,90002) 05630080 ! 567: WRITE (I02,90002) 05640080 ! 568: WRITE (I02,90007) 05650080 ! 569: WRITE (I02,90002) 05660080 ! 570: WRITE (I02,90008) IVFAIL 05670080 ! 571: WRITE (I02,90009) IVPASS 05680080 ! 572: WRITE (I02,90010) IVDELE 05690080 ! 573: C 05700080 ! 574: C 05710080 ! 575: C TERMINATE ROUTINE EXECUTION 05720080 ! 576: STOP 05730080 ! 577: C 05740080 ! 578: C FORMAT STATEMENTS FOR PAGE HEADERS 05750080 ! 579: 90000 FORMAT (1H1) 05760080 ! 580: 90002 FORMAT (1H ) 05770080 ! 581: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 05780080 ! 582: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 05790080 ! 583: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 05800080 ! 584: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 05810080 ! 585: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 05820080 ! 586: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 05830080 ! 587: C 05840080 ! 588: C FORMAT STATEMENTS FOR RUN SUMMARIES 05850080 ! 589: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 05860080 ! 590: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 05870080 ! 591: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 05880080 ! 592: C 05890080 ! 593: C FORMAT STATEMENTS FOR TEST RESULTS 05900080 ! 594: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 05910080 ! 595: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 05920080 ! 596: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 05930080 ! 597: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 05940080 ! 598: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 05950080 ! 599: C 05960080 ! 600: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM080) 05970080 ! 601: END 05980080 ! 602: INTEGER FUNCTION FF081 (IDON01, IDDN10, IDDN20, IDON02) 00010081 ! 603: C DATE***82/08/02*18.33.46 ! 604: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 605: C AUDIT FCVS78 V2.0 ! 606: C 00020081 ! 607: C COMMENT SECTION 00030081 ! 608: C 00040081 ! 609: C FF081 00050081 ! 610: C 00060081 ! 611: C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080. 00070081 ! 612: C THE FUNCTION DUMMY ARGUMENTS IDON01, IDDN10 AND IDDN20 ARE 00080081 ! 613: C INCREMENTED BY 2, 40 AND 70 RESPECTIVELY BEFORE CONTROL IS 00090081 ! 614: C RETURNED TO THE CALLING PROGRAM. VALUE OF THE FUNCTION WILL BE 00100081 ! 615: C THE SUM OF THE ACTUAL ARGUMENTS AS PASSED FROM CALLING PROGRAM. 00110081 ! 616: C 00120081 ! 617: C REFERENCES 00130081 ! 618: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140081 ! 619: C X3.9-1978 00150081 ! 620: C 00160081 ! 621: C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00170081 ! 622: C 00180081 ! 623: C TEST SECTION 00190081 ! 624: C 00200081 ! 625: C FUNCTION SUBPROGRAM 00210081 ! 626: C 00220081 ! 627: DIMENSION IDDN10 (5), IDDN20 (4,4) 00230081 ! 628: IVON01 = IDON01 00240081 ! 629: IVON02 = IDDN10(2) 00250081 ! 630: IVON03 = IDDN20(1,3) 00260081 ! 631: IVON04 = IDON02 00270081 ! 632: C 00280081 ! 633: FF081 = IVON01 + IVON02 + IVON03 + IVON04 00290081 ! 634: IDON01 = IVON01 + 2 00300081 ! 635: IDDN10 (2) = IVON02 + 40 00310081 ! 636: IDDN20 (1,3) = IVON03 + 70 00320081 ! 637: IDDN10 (4) = IVON02 + 40 00330081 ! 638: RETURN 00340081 ! 639: END 00350081 ! 640: REAL FUNCTION FF082 (RDON01, RDDN3A, RDDN1A, RDON02) 00010082 ! 641: C DATE***82/08/02*18.33.46 ! 642: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 643: C AUDIT FCVS78 V2.0 ! 644: DIMENSION RDDN3A (3,6,3), RDDN1A (10) 00020082 ! 645: C 00030082 ! 646: C COMMENT SECTION 00040082 ! 647: C 00050082 ! 648: C FF082 00060082 ! 649: C 00070082 ! 650: C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080. 00080082 ! 651: C THE FUNCTION DUMMY ARGUMENTS RDON01, RDDN3A, AND RDDN1A ARE 00090082 ! 652: C INCREMENTED BY 6.4, 12.2 AND 18.8 RESPECTIVELY BEFORE CONTROL IS 00100082 ! 653: C RETURNED TO THE MAIN PROGRAM. VALUE OF THE FUNCTION WILL BE 00110082 ! 654: C THE SUM OF THE ACTUAL ARGUMENTS AS PASSED TO THE SUBPROGRAM. 00120082 ! 655: C 00130082 ! 656: C REFERENCES 00140082 ! 657: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150082 ! 658: C X3.9-1978 00160082 ! 659: C 00170082 ! 660: C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00180082 ! 661: C 00190082 ! 662: C TEST SECTION 00200082 ! 663: C 00210082 ! 664: C FUNCTION SUBPROGRAM 00220082 ! 665: C 00230082 ! 666: RVON01 = RDON01 00240082 ! 667: RVON02 = RDDN3A (2,5,2) 00250082 ! 668: RVON03 = RDDN1A (5) 00260082 ! 669: RVON04 = RDON02 00270082 ! 670: C 00280082 ! 671: FF082 = RVON01 + RVON02 + RVON03 + RVON04 00290082 ! 672: C 00300082 ! 673: RDON01 = RVON01 + 6.4 00310082 ! 674: RDDN3A (2,5,2) = RVON02 + 12.2 00320082 ! 675: RDDN1A (5) = RVON03 + 18.8 00330082 ! 676: RDDN3A (1,2,1) = 600.0 + 12.2 00340082 ! 677: RETURN 00350082 ! 678: END 00360082 ! 679: FUNCTION FF083 (IDON01,IDDN2A,IDDN3A,RDON02) 00010083 ! 680: C DATE***82/08/02*18.33.46 ! 681: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 682: C AUDIT FCVS78 V2.0 ! 683: DIMENSION IDDN2A (2,2), IDDN3A(3,4,5) 00020083 ! 684: C 00030083 ! 685: C COMMENT SECTION 00040083 ! 686: C 00050083 ! 687: C FF083 00060083 ! 688: C 00070083 ! 689: C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080. 00080083 ! 690: C THE TYPE DECLARATION IS IMPLICIT REAL. 00090083 ! 691: C THE FUNCTION DUMMY ARGUMENTS ARE BOTH INTEGER AND REAL. DUMMY 00100083 ! 692: C ARGUMENTS IDON01, IDDN2A AND IDDN3A ARE INCREMENTED BY 10, 20 AND 00110083 ! 693: C 40 RESPECTIVELY BEFORE CONTROL IS RETURNED TO THE MAIN PROGRAM. 00120083 ! 694: C THE VALUE OF THE FUNCTION RETURNED TO THE REFERENCING PROGRAM 00130083 ! 695: C WILL BE THE SUM OF THE ACTUAL ARGUMENTS AS PASSED TO THE 00140083 ! 696: C SUBPROGRAM FF083. 00150083 ! 697: C DUMMY ARGUMENT IDDN2A CORRESPONDS TO AN ARRAY-NAME IN THE 00160083 ! 698: C ACTUAL ARGUMENT OF THE MAIN PROGRAM. DUMMY ARGUMENT IDDN3A 00170083 ! 699: C CORRESPONDS TO AN ARRAY-ELEMENT-NAME IN THE ACTUAL ARGUMENT OF THE00180083 ! 700: C MAIN PROGRAM. DUMMY ARGUMENT IDON02 CORRESPONDS TO AN EXPRESSION00190083 ! 701: C CONTAINING VARIABLES,ARITHMETIC OPERATORS AND CONSTANTS IN THE 00200083 ! 702: C ACTUAL ARGUMENT OF THE MAIN PROGRAM. 00210083 ! 703: C 00220083 ! 704: C REFERENCES 00230083 ! 705: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00240083 ! 706: C X3.9-1978 00250083 ! 707: C 00260083 ! 708: C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS 00270083 ! 709: C SECTION 15.5.1, FUNCTION SUBPROGRAM 00280083 ! 710: C 00290083 ! 711: C TEST SECTION 00300083 ! 712: C 00310083 ! 713: C FUNCTION SUBPROGRAM 00320083 ! 714: C 00330083 ! 715: IVON01 = IDON01 00340083 ! 716: IVON02 = IDDN2A (1,1) 00350083 ! 717: IVON03 = IDDN3A (2,3,4) 00360083 ! 718: RVON04 = RDON02 00370083 ! 719: C 00380083 ! 720: RVON05 = IVON01 + IVON02 + IVON03 00390083 ! 721: FF083 = RVON05 + RVON04 00400083 ! 722: C 00410083 ! 723: IDON01 = IVON01 + 10 00420083 ! 724: IDDN2A (1,1) = IVON02 + 20 00430083 ! 725: IDDN3A (2,3,4) = IVON03 + 40 00440083 ! 726: C 00450083 ! 727: RETURN 00460083 ! 728: END 00470083
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.