|
|
1.1 ! root 1: PROGRAM FM311 00010311 ! 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 00020311 ! 6: C 00030311 ! 7: C THIS ROUTINE TESTS THE USE OF THE FORTRAN IN-LINE STATEMENT 00040311 ! 8: C FUNCTION OF TYPES INTEGER, REAL AND LOGICAL. SPECIFIC FEATURES 00050311 ! 9: C TESTED INCLUDE, 00060311 ! 10: C 00070311 ! 11: C A) REAL STATEMENT FUNCTIONS USING REAL CONSTANTS AND VARIABLES 00080311 ! 12: C IN THE EXPRESSION AND AS ACTUAL ARGUMENTS. 00090311 ! 13: C 00100311 ! 14: C B) STATEMENT FUNCTIONS WHICH REQUIRE CONVERSION OF THE 00110311 ! 15: C EXPRESSION TO REAL AND INTEGER TYPING. 00120311 ! 16: C 00130311 ! 17: C C) THE USE OF VARIABLES, ARRAY ELEMENTS, EXTERNAL REFERENCES, 00140311 ! 18: C AND INITIALLY DEFINED ENITIIES IN THE EXPRESSION. 00150311 ! 19: C 00160311 ! 20: C D) VARIOUS DEFINITIONS AND USES OF DUMMY ARGUMENTS. 00170311 ! 21: C 00180311 ! 22: C E) ACTUAL ARGUMENTS CONSISTING OF EXPRESSIONS, INTRINSIC 00190311 ! 23: C FUNCTION REFERENCES, AND EXTERNAL FUNCTION REFERENCES. 00200311 ! 24: C 00210311 ! 25: C F) CONFIRMING AND OVERRIDING THE TYPING OF STATEMENT FUNCTIONS 00220311 ! 26: C AND DUMMY ARGUMENTS. 00230311 ! 27: C 00240311 ! 28: C G) USE OF STATEMENT FUNCTIONS AND DUMMY ARGUMENTS IN THE MAIN 00250311 ! 29: C PROGRAM AND IN EXTERNAL FUNCTION AND SUBROUTINE SUBPROGRAMS.00260311 ! 30: C 00270311 ! 31: C THE SUBSET LEVEL FEATURES OF STATEMENT FUNCTIONS ARE ALSO TESTED 00280311 ! 32: C IN ROUTINE FM020. 00290311 ! 33: C 00300311 ! 34: C REFERENCES. 00310311 ! 35: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00320311 ! 36: C X3.9-1978 00330311 ! 37: C 00340311 ! 38: C SECTION 8.3, COMMON STATEMENT 00350311 ! 39: C SECTION 8.4, TYPE-STATEMENT 00360311 ! 40: C SECTION 8.5, IMPLICIT STATEMENT 00370311 ! 41: C SECTION 8.7, EXTERNAL STATEMENT 00380311 ! 42: C SECTION 8.8, INTRINSIC STATEMENT 00390311 ! 43: C SECTION 9, DATA STATEMENT 00400311 ! 44: C SECTION 15.3, INTRINSIC FUNCTIONS 00410311 ! 45: C SECTION 15.4, STATEMENT FUNCTION 00420311 ! 46: C SECTION 15.5, EXTERNAL FUNCTIONS 00430311 ! 47: C SECTION 15.6, SUBROUTINES 00440311 ! 48: C SECTION 15.9.1, DUMMY ARGUMENTS 00450311 ! 49: C SECTION 15.9.2, ACTUAL ARGUMENTS 00460311 ! 50: C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS 00470311 ! 51: C 00480311 ! 52: C 00490311 ! 53: C ******************************************************************00500311 ! 54: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00510311 ! 55: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00520311 ! 56: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00530311 ! 57: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00540311 ! 58: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00550311 ! 59: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00560311 ! 60: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00570311 ! 61: C THE RESULT OF EXECUTING THESE TESTS. 00580311 ! 62: C 00590311 ! 63: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00600311 ! 64: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00610311 ! 65: C 00620311 ! 66: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00630311 ! 67: C DEPARTMENT OF THE NAVY 00640311 ! 68: C FEDERAL COBOL COMPILER TESTING SERVICE 00650311 ! 69: C WASHINGTON, D.C. 20376 00660311 ! 70: C 00670311 ! 71: C ******************************************************************00680311 ! 72: C 00690311 ! 73: C 00700311 ! 74: IMPLICIT LOGICAL (L) 00710311 ! 75: IMPLICIT CHARACTER*14 (C) 00720311 ! 76: C 00730311 ! 77: IMPLICIT INTEGER (A) 00740311 ! 78: IMPLICIT INTEGER (B) 00750311 ! 79: IMPLICIT REAL (K) 00760311 ! 80: IMPLICIT REAL (M) 00770311 ! 81: REAL NDON01 00780311 ! 82: INTEGER EDON01 00790311 ! 83: INTEGER FF312, FF314 00800311 ! 84: EXTERNAL FF312 00810311 ! 85: INTRINSIC NINT 00820311 ! 86: DIMENSION RADN11(4), RADN12(4), RADN13(4) 00830311 ! 87: DIMENSION IADN11(4), IADN12(4) 00840311 ! 88: DIMENSION LADN11(4) 00850311 ! 89: COMMON /IFOS19/IVCN01 00860311 ! 90: DATA IVOND1/6/ 00870311 ! 91: C TEST 001 00880311 ! 92: RFOS01(RDON01) = 3.5 00890311 ! 93: C TEST 002 00900311 ! 94: RFOS02(RDON02) = RDON02 00910311 ! 95: C TEST 003 00920311 ! 96: RFOS03(RDON03) = RDON03 + 1.0 00930311 ! 97: C TEST 004 00940311 ! 98: IFOS01(RDON04) = RDON04 + 1.0 00950311 ! 99: C TEST 005 00960311 ! 100: RFOS04(IDON01) = IDON01 + 1 00970311 ! 101: C TEST 006 00980311 ! 102: IFOS02(IDON02) = IDON02 + 1.95 00990311 ! 103: C TEST 007 01000311 ! 104: IFOS03(IDON03) = IDON03 + IVON01 01010311 ! 105: C TEST 008 01020311 ! 106: RFOS05(RDON05) = RDON05 + RVON02 01030311 ! 107: C TEST 009 01040311 ! 108: LFOS01(LDON01) = LDON01 .OR. LVON01 01050311 ! 109: C TEST 010 01060311 ! 110: IFOS04(IDON04) = IDON04 + IADN11(1) 01070311 ! 111: C TEST 011 01080311 ! 112: RFOS06(RDON06) = RDON06 + RADN12(3) 01090311 ! 113: C TEST 012 01100311 ! 114: LFOS02(LDON02) = .NOT. LDON02 .AND. LADN11(2) 01110311 ! 115: C TEST 013 01120311 ! 116: RFOS07(IDON05) = RADN13(IDON05) 01130311 ! 117: C TEST 014 01140311 ! 118: IFOS05(IDON06) = IDON06 + FF312(4) 01150311 ! 119: C TEST 015 01160311 ! 120: IFOS06(IDON07) = (IDON07 + 1) 01170311 ! 121: C TEST 016 01180311 ! 122: IFOS07(IDON08) = IDON08 + IVOND1 01190311 ! 123: C TEST 017 01200311 ! 124: IFOS08(IDON09) = IDON09 + 1 01210311 ! 125: IFOS09(IDON10) = IFOS08(IDON10) + 1 01220311 ! 126: C TEST 018 01230311 ! 127: IFOS10() = IVON02 01240311 ! 128: C TEST 019 01250311 ! 129: IFOS11(IDON11,IDON12,IDON13) = IDON11 + IDON12 + IDON13 01260311 ! 130: C TEST 020 01270311 ! 131: IFOS12(IDON14) = IDON14 + 1 01280311 ! 132: IFOS13(IDON14) = IDON14 + 2 01290311 ! 133: C TEST 021,022,023 01300311 ! 134: IFOS14(IDON15) = IDON15 + 1 01310311 ! 135: C TEST 024 01320311 ! 136: KFOS01(IDON16) = IDON16 + 1.0 01330311 ! 137: C TEST 025 01340311 ! 138: AFOS01(RDON07) = RDON07 + 1.0 01350311 ! 139: C TEST 026 01360311 ! 140: RFOS08(MDON01) = MDON01 / 5 01370311 ! 141: C TEST 027 01380311 ! 142: RFOS09(BDON01) = BDON01 / 5 01390311 ! 143: C TEST 028 01400311 ! 144: RFOS10(NDON01) = NDON01 / 5 01410311 ! 145: C TEST 029 01420311 ! 146: RFOS11(EDON01) = EDON01 / 5 01430311 ! 147: C TEST 030 01440311 ! 148: IFOS15(IVON04) = IVON04 + 1 01450311 ! 149: C TEST 031 01460311 ! 150: IFOS16(IDON17) = IDON17 + 1 01470311 ! 151: C TEST 032 01480311 ! 152: IFOS17(IDON18) = IDON18 + 1 01490311 ! 153: C TEST 037 01500311 ! 154: IFOS19(IDON21) = IDON21 + 1 01510311 ! 155: C 01520311 ! 156: C 01530311 ! 157: C 01540311 ! 158: C INITIALIZATION SECTION. 01550311 ! 159: C 01560311 ! 160: C INITIALIZE CONSTANTS 01570311 ! 161: C ******************** 01580311 ! 162: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01590311 ! 163: I01 = 5 01600311 ! 164: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01610311 ! 165: I02 = 6 01620311 ! 166: C SYSTEM ENVIRONMENT SECTION 01630311 ! 167: C 01640311 ! 168: I01 = 5 01650311 ! 169: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01660311 ! 170: C (UNIT NUMBER FOR CARD READER). 01670311 ! 171: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01680311 ! 172: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01690311 ! 173: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01700311 ! 174: C 01710311 ! 175: I02 = 6 01720311 ! 176: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01730311 ! 177: C (UNIT NUMBER FOR PRINTER). 01740311 ! 178: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01750311 ! 179: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01760311 ! 180: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01770311 ! 181: C 01780311 ! 182: IVPASS = 0 01790311 ! 183: IVFAIL = 0 01800311 ! 184: IVDELE = 0 01810311 ! 185: ICZERO = 0 01820311 ! 186: C 01830311 ! 187: C WRITE OUT PAGE HEADERS 01840311 ! 188: C 01850311 ! 189: WRITE (I02,90002) 01860311 ! 190: WRITE (I02,90006) 01870311 ! 191: WRITE (I02,90008) 01880311 ! 192: WRITE (I02,90004) 01890311 ! 193: WRITE (I02,90010) 01900311 ! 194: WRITE (I02,90004) 01910311 ! 195: WRITE (I02,90016) 01920311 ! 196: WRITE (I02,90001) 01930311 ! 197: WRITE (I02,90004) 01940311 ! 198: WRITE (I02,90012) 01950311 ! 199: WRITE (I02,90014) 01960311 ! 200: WRITE (I02,90004) 01970311 ! 201: C 01980311 ! 202: C 01990311 ! 203: C TEST 001 THROUGH TEST 003 TEST REAL STATEMENT FUNCTIONS WHERE THE 02000311 ! 204: C EXPRESSION CONSISTS OF REAL CONSTANTS AND VARIABLES AND THE ACTUAL02010311 ! 205: C ARGUMENTS ARE EITHER REAL CONSTANTS OR VARIABLES. 02020311 ! 206: C 02030311 ! 207: C 02040311 ! 208: C **** FCVS PROGRAM 311 - TEST 001 **** 02050311 ! 209: C 02060311 ! 210: C EXPRESSION CONSISTS OF REAL CONSTANT (NO DUMMY ARGUMENT). 02070311 ! 211: C 02080311 ! 212: IVTNUM = 1 02090311 ! 213: IF (ICZERO) 30010, 0010, 30010 02100311 ! 214: 0010 CONTINUE 02110311 ! 215: RVCOMP = 0.0 02120311 ! 216: RVCOMP = RFOS01(1.0) 02130311 ! 217: RVCORR = 3.5 02140311 ! 218: 40010 IF (RVCOMP - 3.4995) 20010, 10010, 40011 02150311 ! 219: 40011 IF (RVCOMP - 3.5005) 10010, 10010, 20010 02160311 ! 220: 30010 IVDELE = IVDELE + 1 02170311 ! 221: WRITE (I02,80000) IVTNUM 02180311 ! 222: IF (ICZERO) 10010, 0021, 20010 02190311 ! 223: 10010 IVPASS = IVPASS + 1 02200311 ! 224: WRITE (I02,80002) IVTNUM 02210311 ! 225: GO TO 0021 02220311 ! 226: 20010 IVFAIL = IVFAIL + 1 02230311 ! 227: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02240311 ! 228: 0021 CONTINUE 02250311 ! 229: C 02260311 ! 230: C **** FCVS PROGRAM 311 - TEST 002 **** 02270311 ! 231: C 02280311 ! 232: C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL 02290311 ! 233: C CONSTANT. 02300311 ! 234: C 02310311 ! 235: IVTNUM = 2 02320311 ! 236: IF (ICZERO) 30020, 0020, 30020 02330311 ! 237: 0020 CONTINUE 02340311 ! 238: RVCOMP = 0.0 02350311 ! 239: RVCOMP = RFOS02(1.3333) 02360311 ! 240: RVCORR = 1.3333 02370311 ! 241: 40020 IF (RVCOMP - 1.3328) 20020, 10020, 40021 02380311 ! 242: 40021 IF (RVCOMP - 1.3338) 10020, 10020, 20020 02390311 ! 243: 30020 IVDELE = IVDELE + 1 02400311 ! 244: WRITE (I02,80000) IVTNUM 02410311 ! 245: IF (ICZERO) 10020, 0031, 20020 02420311 ! 246: 10020 IVPASS = IVPASS + 1 02430311 ! 247: WRITE (I02,80002) IVTNUM 02440311 ! 248: GO TO 0031 02450311 ! 249: 20020 IVFAIL = IVFAIL + 1 02460311 ! 250: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02470311 ! 251: 0031 CONTINUE 02480311 ! 252: C 02490311 ! 253: C **** FCVS PROGRAM 311 - TEST 003 **** 02500311 ! 254: C 02510311 ! 255: C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL 02520311 ! 256: C VARIABLE. 02530311 ! 257: C 02540311 ! 258: IVTNUM = 3 02550311 ! 259: IF (ICZERO) 30030, 0030, 30030 02560311 ! 260: 0030 CONTINUE 02570311 ! 261: RVCOMP = 0.0 02580311 ! 262: RVON01 = 4.5 02590311 ! 263: RVCOMP = RFOS03(RVON01) 02600311 ! 264: RVCORR = 5.5 02610311 ! 265: 40030 IF (RVCOMP - 5.4995) 20030, 10030, 40031 02620311 ! 266: 40031 IF (RVCOMP - 5.5005) 10030, 10030, 20030 02630311 ! 267: 30030 IVDELE = IVDELE + 1 02640311 ! 268: WRITE (I02,80000) IVTNUM 02650311 ! 269: IF (ICZERO) 10030, 0041, 20030 02660311 ! 270: 10030 IVPASS = IVPASS + 1 02670311 ! 271: WRITE (I02,80002) IVTNUM 02680311 ! 272: GO TO 0041 02690311 ! 273: 20030 IVFAIL = IVFAIL + 1 02700311 ! 274: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02710311 ! 275: 0041 CONTINUE 02720311 ! 276: C 02730311 ! 277: C TEST 004 THROUGH TEST 006 TEST STATEMENT FUNCTIONS WHICH REQUIRE 02740311 ! 278: C TYPE CONVERSION OF THE EXPRESSION. 02750311 ! 279: C 02760311 ! 280: C 02770311 ! 281: C **** FCVS PROGRAM 311 - TEST 004 **** 02780311 ! 282: C 02790311 ! 283: C INTEGER STATEMENT FUNCTION WITH REAL EXPRESSION. 02800311 ! 284: C 02810311 ! 285: IVTNUM = 4 02820311 ! 286: IF (ICZERO) 30040, 0040, 30040 02830311 ! 287: 0040 CONTINUE 02840311 ! 288: IVCOMP = 0 02850311 ! 289: IVCOMP = IFOS01(2.3) 02860311 ! 290: IVCORR = 3 02870311 ! 291: 40040 IF (IVCOMP - 3) 20040, 10040, 20040 02880311 ! 292: 30040 IVDELE = IVDELE + 1 02890311 ! 293: WRITE (I02,80000) IVTNUM 02900311 ! 294: IF (ICZERO) 10040, 0051, 20040 02910311 ! 295: 10040 IVPASS = IVPASS + 1 02920311 ! 296: WRITE (I02,80002) IVTNUM 02930311 ! 297: GO TO 0051 02940311 ! 298: 20040 IVFAIL = IVFAIL + 1 02950311 ! 299: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02960311 ! 300: 0051 CONTINUE 02970311 ! 301: C 02980311 ! 302: C **** FCVS PROGRAM 311 - TEST 005 **** 02990311 ! 303: C 03000311 ! 304: C REAL STATEMENT FUNCTION WITH INTEGER EXPRESSION 03010311 ! 305: C 03020311 ! 306: IVTNUM = 5 03030311 ! 307: IF (ICZERO) 30050, 0050, 30050 03040311 ! 308: 0050 CONTINUE 03050311 ! 309: RVCOMP = 0.0 03060311 ! 310: RVCOMP = RFOS04(3) 03070311 ! 311: RVCORR = 4.0 03080311 ! 312: 40050 IF (RVCOMP - 3.9995) 20050, 10050, 40051 03090311 ! 313: 40051 IF (RVCOMP - 4.0005) 10050, 10050, 20050 03100311 ! 314: 30050 IVDELE = IVDELE + 1 03110311 ! 315: WRITE (I02,80000) IVTNUM 03120311 ! 316: IF (ICZERO) 10050, 0061, 20050 03130311 ! 317: 10050 IVPASS = IVPASS + 1 03140311 ! 318: WRITE (I02,80002) IVTNUM 03150311 ! 319: GO TO 0061 03160311 ! 320: 20050 IVFAIL = IVFAIL + 1 03170311 ! 321: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03180311 ! 322: 0061 CONTINUE 03190311 ! 323: C 03200311 ! 324: C **** FCVS PROGRAM 311 - TEST 006 **** 03210311 ! 325: C 03220311 ! 326: C INTEGER STATEMENT FUNCTION WITH EXPRESSION CONSISTING OF INTEGER 03230311 ! 327: C AND REAL PRIMARIES. 03240311 ! 328: C 03250311 ! 329: IVTNUM = 6 03260311 ! 330: IF (ICZERO) 30060, 0060, 30060 03270311 ! 331: 0060 CONTINUE 03280311 ! 332: IVCOMP = 0 03290311 ! 333: IVCOMP = IFOS02(2) 03300311 ! 334: IVCORR = 3 03310311 ! 335: 40060 IF (IVCOMP - 3) 20060, 10060, 20060 03320311 ! 336: 30060 IVDELE = IVDELE + 1 03330311 ! 337: WRITE (I02,80000) IVTNUM 03340311 ! 338: IF (ICZERO) 10060, 0071, 20060 03350311 ! 339: 10060 IVPASS = IVPASS + 1 03360311 ! 340: WRITE (I02,80002) IVTNUM 03370311 ! 341: GO TO 0071 03380311 ! 342: 20060 IVFAIL = IVFAIL + 1 03390311 ! 343: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03400311 ! 344: 0071 CONTINUE 03410311 ! 345: C 03420311 ! 346: C TEST 007 THROUGH TEST 017 TEST THE USAGE OF VARIOUS PRIMARIES 03430311 ! 347: C IN THE EXPRESSION OF A STATEMENT FUNCTION. 03440311 ! 348: C 03450311 ! 349: C 03460311 ! 350: C **** FCVS PROGRAM 311 - TEST 007 **** 03470311 ! 351: C 03480311 ! 352: C USE INTEGER VARIABLE AS PRIMARY 03490311 ! 353: C 03500311 ! 354: IVTNUM = 7 03510311 ! 355: IF (ICZERO) 30070, 0070, 30070 03520311 ! 356: 0070 CONTINUE 03530311 ! 357: IVCOMP = 0 03540311 ! 358: IVON01 = 3 03550311 ! 359: IVCOMP = IFOS03(4) 03560311 ! 360: IVCORR = 7 03570311 ! 361: 40070 IF (IVCOMP - 7) 20070, 10070, 20070 03580311 ! 362: 30070 IVDELE = IVDELE + 1 03590311 ! 363: WRITE (I02,80000) IVTNUM 03600311 ! 364: IF (ICZERO) 10070, 0081, 20070 03610311 ! 365: 10070 IVPASS = IVPASS + 1 03620311 ! 366: WRITE (I02,80002) IVTNUM 03630311 ! 367: GO TO 0081 03640311 ! 368: 20070 IVFAIL = IVFAIL + 1 03650311 ! 369: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03660311 ! 370: 0081 CONTINUE 03670311 ! 371: C 03680311 ! 372: C **** FCVS PROGRAM 311 - TEST 008 **** 03690311 ! 373: C 03700311 ! 374: C USE REAL VARIABLE AS PRIMARY. 03710311 ! 375: C 03720311 ! 376: IVTNUM = 8 03730311 ! 377: IF (ICZERO) 30080, 0080, 30080 03740311 ! 378: 0080 CONTINUE 03750311 ! 379: RVCOMP = 0.0 03760311 ! 380: RVON02 = 1.5 03770311 ! 381: RADN11(2) = 1.3 03780311 ! 382: RVCOMP = RFOS05(RADN11(2)) 03790311 ! 383: RVCORR = 2.8 03800311 ! 384: 40080 IF (RVCOMP - 2.7995) 20080, 10080, 40081 03810311 ! 385: 40081 IF (RVCOMP - 2.8005) 10080, 10080, 20080 03820311 ! 386: 30080 IVDELE = IVDELE + 1 03830311 ! 387: WRITE (I02,80000) IVTNUM 03840311 ! 388: IF (ICZERO) 10080, 0091, 20080 03850311 ! 389: 10080 IVPASS = IVPASS + 1 03860311 ! 390: WRITE (I02,80002) IVTNUM 03870311 ! 391: GO TO 0091 03880311 ! 392: 20080 IVFAIL = IVFAIL + 1 03890311 ! 393: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03900311 ! 394: 0091 CONTINUE 03910311 ! 395: C 03920311 ! 396: C **** FCVS PROGRAM 311 - TEST 009 **** 03930311 ! 397: C 03940311 ! 398: C USE LOGICAL VARIABLE AS PRIMARY. 03950311 ! 399: C 03960311 ! 400: IVTNUM = 9 03970311 ! 401: IF (ICZERO) 30090, 0090, 30090 03980311 ! 402: 0090 CONTINUE 03990311 ! 403: LVON01 = .TRUE. 04000311 ! 404: IVCOMP = 0 04010311 ! 405: IF (LFOS01(.FALSE.)) IVCOMP = 1 04020311 ! 406: IVCORR = 1 04030311 ! 407: 40090 IF (IVCOMP - 1) 20090, 10090, 20090 04040311 ! 408: 30090 IVDELE = IVDELE + 1 04050311 ! 409: WRITE (I02,80000) IVTNUM 04060311 ! 410: IF (ICZERO) 10090, 0101, 20090 04070311 ! 411: 10090 IVPASS = IVPASS + 1 04080311 ! 412: WRITE (I02,80002) IVTNUM 04090311 ! 413: GO TO 0101 04100311 ! 414: 20090 IVFAIL = IVFAIL + 1 04110311 ! 415: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04120311 ! 416: 0101 CONTINUE 04130311 ! 417: C 04140311 ! 418: C **** FCVS PROGRAM 311 - TEST 010 **** 04150311 ! 419: C 04160311 ! 420: C USE INTEGER ARRAY ELEMENT NAME AS PRIMARY. 04170311 ! 421: C 04180311 ! 422: IVTNUM = 10 04190311 ! 423: IF (ICZERO) 30100, 0100, 30100 04200311 ! 424: 0100 CONTINUE 04210311 ! 425: IVCOMP = 0 04220311 ! 426: IADN11(1) = 7 04230311 ! 427: IVCOMP = IFOS04(-4) 04240311 ! 428: IVCORR = 3 04250311 ! 429: 40100 IF (IVCOMP - 3) 20100, 10100, 20100 04260311 ! 430: 30100 IVDELE = IVDELE + 1 04270311 ! 431: WRITE (I02,80000) IVTNUM 04280311 ! 432: IF (ICZERO) 10100, 0111, 20100 04290311 ! 433: 10100 IVPASS = IVPASS + 1 04300311 ! 434: WRITE (I02,80002) IVTNUM 04310311 ! 435: GO TO 0111 04320311 ! 436: 20100 IVFAIL = IVFAIL + 1 04330311 ! 437: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04340311 ! 438: 0111 CONTINUE 04350311 ! 439: C 04360311 ! 440: C **** FCVS PROGRAM 311 - TEST 011 **** 04370311 ! 441: C 04380311 ! 442: C USE REAL ARRAY ELEMENT NAME AS PRIMARY. 04390311 ! 443: C 04400311 ! 444: IVTNUM = 11 04410311 ! 445: IF (ICZERO) 30110, 0110, 30110 04420311 ! 446: 0110 CONTINUE 04430311 ! 447: RVCOMP = 0.0 04440311 ! 448: RADN12(3) = 1.23 04450311 ! 449: RVCOMP = RFOS06(3.0) 04460311 ! 450: RVCORR = 4.23 04470311 ! 451: 40110 IF (RVCOMP - 4.2295) 20110, 10110, 40111 04480311 ! 452: 40111 IF (RVCOMP - 4.2305) 10110, 10110, 20110 04490311 ! 453: 30110 IVDELE = IVDELE + 1 04500311 ! 454: WRITE (I02,80000) IVTNUM 04510311 ! 455: IF (ICZERO) 10110, 0121, 20110 04520311 ! 456: 10110 IVPASS = IVPASS + 1 04530311 ! 457: WRITE (I02,80002) IVTNUM 04540311 ! 458: GO TO 0121 04550311 ! 459: 20110 IVFAIL = IVFAIL + 1 04560311 ! 460: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04570311 ! 461: 0121 CONTINUE 04580311 ! 462: C 04590311 ! 463: C **** FCVS PROGRAM 311 - TEST 012 **** 04600311 ! 464: C 04610311 ! 465: C USE LOGICAL ARRAY ELEMENT NAME AS PRIMARY. 04620311 ! 466: C 04630311 ! 467: IVTNUM = 12 04640311 ! 468: IF (ICZERO) 30120, 0120, 30120 04650311 ! 469: 0120 CONTINUE 04660311 ! 470: LADN11(2) = .TRUE. 04670311 ! 471: IVCOMP = 0 04680311 ! 472: IF (LFOS02(.FALSE.)) IVCOMP = 1 04690311 ! 473: IVCORR = 1 04700311 ! 474: 40120 IF (IVCOMP - 1) 20120, 10120, 20120 04710311 ! 475: 30120 IVDELE = IVDELE + 1 04720311 ! 476: WRITE (I02,80000) IVTNUM 04730311 ! 477: IF (ICZERO) 10120, 0131, 20120 04740311 ! 478: 10120 IVPASS = IVPASS + 1 04750311 ! 479: WRITE (I02,80002) IVTNUM 04760311 ! 480: GO TO 0131 04770311 ! 481: 20120 IVFAIL = IVFAIL + 1 04780311 ! 482: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04790311 ! 483: 0131 CONTINUE 04800311 ! 484: C 04810311 ! 485: C **** FCVS PROGRAM 311 - TEST 013 **** 04820311 ! 486: C 04830311 ! 487: C USE A REAL ARRAY ELEMENT NAME AS PRIMARY WHERE THE SUBSCRIPT 04840311 ! 488: C VALUE IS THE DUMMY ARGUMENT NAME. 04850311 ! 489: C 04860311 ! 490: IVTNUM = 13 04870311 ! 491: IF (ICZERO) 30130, 0130, 30130 04880311 ! 492: 0130 CONTINUE 04890311 ! 493: RVCOMP = 0.0 04900311 ! 494: RADN13(4) = 13.4 04910311 ! 495: RVCOMP = RFOS07(4) 04920311 ! 496: RVCORR = 13.4 04930311 ! 497: 40130 IF (RVCOMP - 13.395) 20130, 10130, 40131 04940311 ! 498: 40131 IF (RVCOMP - 13.405) 10130, 10130, 20130 04950311 ! 499: 30130 IVDELE = IVDELE + 1 04960311 ! 500: WRITE (I02,80000) IVTNUM 04970311 ! 501: IF (ICZERO) 10130, 0141, 20130 04980311 ! 502: 10130 IVPASS = IVPASS + 1 04990311 ! 503: WRITE (I02,80002) IVTNUM 05000311 ! 504: GO TO 0141 05010311 ! 505: 20130 IVFAIL = IVFAIL + 1 05020311 ! 506: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05030311 ! 507: 0141 CONTINUE 05040311 ! 508: C 05050311 ! 509: C **** FCVS PROGRAM 311 - TEST 014 **** 05060311 ! 510: C 05070311 ! 511: C USE EXTERNAL FUNCTION REFERENCE AS PRIMARY. 05080311 ! 512: C 05090311 ! 513: IVTNUM = 14 05100311 ! 514: IF (ICZERO) 30140, 0140, 30140 05110311 ! 515: 0140 CONTINUE 05120311 ! 516: IVCOMP = 0 05130311 ! 517: IVCOMP = IFOS05(6) 05140311 ! 518: IVCORR = 11 05150311 ! 519: 40140 IF (IVCOMP - 11) 20140, 10140, 20140 05160311 ! 520: 30140 IVDELE = IVDELE + 1 05170311 ! 521: WRITE (I02,80000) IVTNUM 05180311 ! 522: IF (ICZERO) 10140, 0151, 20140 05190311 ! 523: 10140 IVPASS = IVPASS + 1 05200311 ! 524: WRITE (I02,80002) IVTNUM 05210311 ! 525: GO TO 0151 05220311 ! 526: 20140 IVFAIL = IVFAIL + 1 05230311 ! 527: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05240311 ! 528: 0151 CONTINUE 05250311 ! 529: C 05260311 ! 530: C **** FCVS PROGRAM 311 - TEST 015 **** 05270311 ! 531: C 05280311 ! 532: C USE EXPRESSION ENCLOSED IN PARENTHESES. 05290311 ! 533: C 05300311 ! 534: IVTNUM = 15 05310311 ! 535: IF (ICZERO) 30150, 0150, 30150 05320311 ! 536: 0150 CONTINUE 05330311 ! 537: IVCOMP = 0 05340311 ! 538: IVCOMP = IFOS06(4) 05350311 ! 539: IVCORR = 5 05360311 ! 540: 40150 IF (IVCOMP - 5) 20150, 10150, 20150 05370311 ! 541: 30150 IVDELE = IVDELE + 1 05380311 ! 542: WRITE (I02,80000) IVTNUM 05390311 ! 543: IF (ICZERO) 10150, 0161, 20150 05400311 ! 544: 10150 IVPASS = IVPASS + 1 05410311 ! 545: WRITE (I02,80002) IVTNUM 05420311 ! 546: GO TO 0161 05430311 ! 547: 20150 IVFAIL = IVFAIL + 1 05440311 ! 548: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05450311 ! 549: 0161 CONTINUE 05460311 ! 550: C 05470311 ! 551: C **** FCVS PROGRAM 311 - TEST 016 **** 05480311 ! 552: C 05490311 ! 553: C USE VARIABLE INITIALLY DEFINED IN DATA STATEMENT AS PRIMARY. 05500311 ! 554: C 05510311 ! 555: IVTNUM = 16 05520311 ! 556: IF (ICZERO) 30160, 0160, 30160 05530311 ! 557: 0160 CONTINUE 05540311 ! 558: IVCOMP = 0 05550311 ! 559: IVCOMP = IFOS07(3) 05560311 ! 560: IVCORR = 9 05570311 ! 561: 40160 IF (IVCOMP - 9) 20160, 10160, 20160 05580311 ! 562: 30160 IVDELE = IVDELE + 1 05590311 ! 563: WRITE (I02,80000) IVTNUM 05600311 ! 564: IF (ICZERO) 10160, 0171, 20160 05610311 ! 565: 10160 IVPASS = IVPASS + 1 05620311 ! 566: WRITE (I02,80002) IVTNUM 05630311 ! 567: GO TO 0171 05640311 ! 568: 20160 IVFAIL = IVFAIL + 1 05650311 ! 569: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05660311 ! 570: 0171 CONTINUE 05670311 ! 571: C 05680311 ! 572: C **** FCVS PROGRAM 311 - TEST 017 **** 05690311 ! 573: C 05700311 ! 574: C USE PREVIOUSLY DEFINED STATEMENT FUNCTION REFERENCE AS PRIMARY. 05710311 ! 575: C 05720311 ! 576: IVTNUM = 17 05730311 ! 577: IF (ICZERO) 30170, 0170, 30170 05740311 ! 578: 0170 CONTINUE 05750311 ! 579: IVCOMP = 0 05760311 ! 580: IVCOMP = IFOS09(3) 05770311 ! 581: IVCORR = 5 05780311 ! 582: 40170 IF (IVCOMP - 5) 20170, 10170, 20170 05790311 ! 583: 30170 IVDELE = IVDELE + 1 05800311 ! 584: WRITE (I02,80000) IVTNUM 05810311 ! 585: IF (ICZERO) 10170, 0181, 20170 05820311 ! 586: 10170 IVPASS = IVPASS + 1 05830311 ! 587: WRITE (I02,80002) IVTNUM 05840311 ! 588: GO TO 0181 05850311 ! 589: 20170 IVFAIL = IVFAIL + 1 05860311 ! 590: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05870311 ! 591: 0181 CONTINUE 05880311 ! 592: C 05890311 ! 593: C TEST 018 THROUGH TEST 020 APPLY TO THE DEFINITION OF THE 05900311 ! 594: C STATEMENT FUNCTION DUMMY ARGUMENTS. 05910311 ! 595: C 05920311 ! 596: C 05930311 ! 597: C **** FCVS PROGRAM 311 - TEST 018 **** 05940311 ! 598: C 05950311 ! 599: C DEFINE STATEMENT FUNCTION WITH NO DUMMY ARGUMENTS. 05960311 ! 600: C 05970311 ! 601: IVTNUM = 18 05980311 ! 602: IF (ICZERO) 30180, 0180, 30180 05990311 ! 603: 0180 CONTINUE 06000311 ! 604: IVCOMP = 0 06010311 ! 605: IVON02 = 4 06020311 ! 606: IVCOMP = IFOS10() 06030311 ! 607: IVCORR = 4 06040311 ! 608: 40180 IF (IVCOMP - 4) 20180, 10180, 20180 06050311 ! 609: 30180 IVDELE = IVDELE + 1 06060311 ! 610: WRITE (I02,80000) IVTNUM 06070311 ! 611: IF (ICZERO) 10180, 0191, 20180 06080311 ! 612: 10180 IVPASS = IVPASS + 1 06090311 ! 613: WRITE (I02,80002) IVTNUM 06100311 ! 614: GO TO 0191 06110311 ! 615: 20180 IVFAIL = IVFAIL + 1 06120311 ! 616: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06130311 ! 617: 0191 CONTINUE 06140311 ! 618: C 06150311 ! 619: C **** FCVS PROGRAM 311 - TEST 019 **** 06160311 ! 620: C 06170311 ! 621: C DEFINE STATEMENT FUNCTION WITH THREE DUMMY ARGUMENTS. 06180311 ! 622: C 06190311 ! 623: IVTNUM = 19 06200311 ! 624: IF (ICZERO) 30190, 0190, 30190 06210311 ! 625: 0190 CONTINUE 06220311 ! 626: IVCOMP = 0 06230311 ! 627: IVCOMP = IFOS11(1,2,3) 06240311 ! 628: IVCORR = 6 06250311 ! 629: 40190 IF (IVCOMP - 6) 20190, 10190, 20190 06260311 ! 630: 30190 IVDELE = IVDELE + 1 06270311 ! 631: WRITE (I02,80000) IVTNUM 06280311 ! 632: IF (ICZERO) 10190, 0201, 20190 06290311 ! 633: 10190 IVPASS = IVPASS + 1 06300311 ! 634: WRITE (I02,80002) IVTNUM 06310311 ! 635: GO TO 0201 06320311 ! 636: 20190 IVFAIL = IVFAIL + 1 06330311 ! 637: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06340311 ! 638: 0201 CONTINUE 06350311 ! 639: C 06360311 ! 640: C **** FCVS PROGRAM 311 - TEST 020 **** 06370311 ! 641: C 06380311 ! 642: C USE THE SAME DUMMY ARGUMENT NAME IN TWO DIFFERENT 06390311 ! 643: C STATEMENT FUNCTIONS. 06400311 ! 644: C 06410311 ! 645: IVTNUM = 20 06420311 ! 646: IF (ICZERO) 30200, 0200, 30200 06430311 ! 647: 0200 CONTINUE 06440311 ! 648: IVCOMP = 1 06450311 ! 649: IF (IFOS12(3) .EQ. 4) IVCOMP = IVCOMP * 2 06460311 ! 650: IF (IFOS13(4) .EQ. 6) IVCOMP = IVCOMP * 3 06470311 ! 651: IVCORR = 6 06480311 ! 652: C 6 = 2 * 3 06490311 ! 653: 40200 IF (IVCOMP - 6) 20200, 10200, 20200 06500311 ! 654: 30200 IVDELE = IVDELE + 1 06510311 ! 655: WRITE (I02,80000) IVTNUM 06520311 ! 656: IF (ICZERO) 10200, 0211, 20200 06530311 ! 657: 10200 IVPASS = IVPASS + 1 06540311 ! 658: WRITE (I02,80002) IVTNUM 06550311 ! 659: GO TO 0211 06560311 ! 660: 20200 IVFAIL = IVFAIL + 1 06570311 ! 661: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06580311 ! 662: 0211 CONTINUE 06590311 ! 663: C 06600311 ! 664: C TEST 021 THROUGH TEST 022 TEST THE USAGE OF DIFFERENT TYPES OF 06610311 ! 665: C ACTUAL ARGUMENTS IN A STATEMENT FUNCTION REFERENCE. 06620311 ! 666: C 06630311 ! 667: C 06640311 ! 668: C **** FCVS PROGRAM 311 - TEST 021 **** 06650311 ! 669: C 06660311 ! 670: C USE AN EXPRESSION WITH OPERATORS AS AN ACTUAL ARGUMENT. 06670311 ! 671: C 06680311 ! 672: IVTNUM = 21 06690311 ! 673: IF (ICZERO) 30210, 0210, 30210 06700311 ! 674: 0210 CONTINUE 06710311 ! 675: IVCOMP = 0 06720311 ! 676: IVON03 = 4 06730311 ! 677: IVCOMP = IFOS14(IVON03 * 4 + 1) 06740311 ! 678: IVCORR = 18 06750311 ! 679: 40210 IF (IVCOMP - 18) 20210, 10210, 20210 06760311 ! 680: 30210 IVDELE = IVDELE + 1 06770311 ! 681: WRITE (I02,80000) IVTNUM 06780311 ! 682: IF (ICZERO) 10210, 0221, 20210 06790311 ! 683: 10210 IVPASS = IVPASS + 1 06800311 ! 684: WRITE (I02,80002) IVTNUM 06810311 ! 685: GO TO 0221 06820311 ! 686: 20210 IVFAIL = IVFAIL + 1 06830311 ! 687: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06840311 ! 688: 0221 CONTINUE 06850311 ! 689: C 06860311 ! 690: C **** FCVS PROGRAM 311 - TEST 022 **** 06870311 ! 691: C 06880311 ! 692: C USE AN INTRINSIC FUNCTION REFERENCE AS AN ACTUAL ARGUMENT. 06890311 ! 693: C 06900311 ! 694: IVTNUM = 22 06910311 ! 695: IF (ICZERO) 30220, 0220, 30220 06920311 ! 696: 0220 CONTINUE 06930311 ! 697: IVCOMP = 0 06940311 ! 698: RVON01 = 1.75 06950311 ! 699: IVCOMP = IFOS14(NINT(RVON01)) 06960311 ! 700: IVCORR = 3 06970311 ! 701: 40220 IF (IVCOMP - 3) 20220, 10220, 20220 06980311 ! 702: 30220 IVDELE = IVDELE + 1 06990311 ! 703: WRITE (I02,80000) IVTNUM 07000311 ! 704: IF (ICZERO) 10220, 0231, 20220 07010311 ! 705: 10220 IVPASS = IVPASS + 1 07020311 ! 706: WRITE (I02,80002) IVTNUM 07030311 ! 707: GO TO 0231 07040311 ! 708: 20220 IVFAIL = IVFAIL + 1 07050311 ! 709: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07060311 ! 710: 0231 CONTINUE 07070311 ! 711: C 07080311 ! 712: C **** FCVS PROGRAM 311 - TEST 023 **** 07090311 ! 713: C 07100311 ! 714: C USE AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL ARGUMENT. 07110311 ! 715: C 07120311 ! 716: IVTNUM = 23 07130311 ! 717: IF (ICZERO) 30230, 0230, 30230 07140311 ! 718: 0230 CONTINUE 07150311 ! 719: IVCOMP = 0 07160311 ! 720: IVCOMP = IFOS14(FF312(5)) 07170311 ! 721: IVCORR = 7 07180311 ! 722: 40230 IF (IVCOMP - 7) 20230, 10230, 20230 07190311 ! 723: 30230 IVDELE = IVDELE + 1 07200311 ! 724: WRITE (I02,80000) IVTNUM 07210311 ! 725: IF (ICZERO) 10230, 0241, 20230 07220311 ! 726: 10230 IVPASS = IVPASS + 1 07230311 ! 727: WRITE (I02,80002) IVTNUM 07240311 ! 728: GO TO 0241 07250311 ! 729: 20230 IVFAIL = IVFAIL + 1 07260311 ! 730: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07270311 ! 731: 0241 CONTINUE 07280311 ! 732: C 07290311 ! 733: C TEST 024 THROUGH TEST 029 APPLY TO THE TYPING OF STATEMENT 07300311 ! 734: C FUNCTIONS AND THE ASSOCIATED DUMMY ARGUMENT NAMES. 07310311 ! 735: C 07320311 ! 736: C 07330311 ! 737: C **** FCVS PROGRAM 311 - TEST 024 **** 07340311 ! 738: C 07350311 ! 739: C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION WITH 07360311 ! 740: C THE IMPLICIT STATEMENT TYPING OF REAL. 07370311 ! 741: C 07380311 ! 742: IVTNUM = 24 07390311 ! 743: IF (ICZERO) 30240, 0240, 30240 07400311 ! 744: 0240 CONTINUE 07410311 ! 745: RVCOMP = 10.0 07420311 ! 746: RVCOMP = KFOS01(3) / 5 07430311 ! 747: RVCORR = 0.8 07440311 ! 748: 40240 IF (RVCOMP - .79995) 20240, 10240, 40241 07450311 ! 749: 40241 IF (RVCOMP - .80005) 10240, 10240, 20240 07460311 ! 750: 30240 IVDELE = IVDELE + 1 07470311 ! 751: WRITE (I02,80000) IVTNUM 07480311 ! 752: IF (ICZERO) 10240, 0251, 20240 07490311 ! 753: 10240 IVPASS = IVPASS + 1 07500311 ! 754: WRITE (I02,80002) IVTNUM 07510311 ! 755: GO TO 0251 07520311 ! 756: 20240 IVFAIL = IVFAIL + 1 07530311 ! 757: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07540311 ! 758: 0251 CONTINUE 07550311 ! 759: C 07560311 ! 760: C **** FCVS PROGRAM 311 - TEST 025 **** 07570311 ! 761: C 07580311 ! 762: C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION WITH 07590311 ! 763: C THE IMPLICIT STATEMENT TYPING OF INTEGER. 07600311 ! 764: C 07610311 ! 765: IVTNUM = 25 07620311 ! 766: IF (ICZERO) 30250, 0250, 30250 07630311 ! 767: 0250 CONTINUE 07640311 ! 768: RVCOMP = 10.0 07650311 ! 769: RVCOMP = AFOS01(3.0) / 5 07660311 ! 770: RVCORR = 0.0 07670311 ! 771: 40250 IF (RVCOMP + .00005) 20250, 10250, 40251 07680311 ! 772: 40251 IF (RVCOMP - .00005) 10250, 10250, 20250 07690311 ! 773: 30250 IVDELE = IVDELE + 1 07700311 ! 774: WRITE (I02,80000) IVTNUM 07710311 ! 775: IF (ICZERO) 10250, 0261, 20250 07720311 ! 776: 10250 IVPASS = IVPASS + 1 07730311 ! 777: WRITE (I02,80002) IVTNUM 07740311 ! 778: GO TO 0261 07750311 ! 779: 20250 IVFAIL = IVFAIL + 1 07760311 ! 780: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07770311 ! 781: 0261 CONTINUE 07780311 ! 782: C 07790311 ! 783: C **** FCVS PROGRAM 311 - TEST 026 **** 07800311 ! 784: C 07810311 ! 785: C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION 07820311 ! 786: C DUMMY ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF REAL. 07830311 ! 787: C 07840311 ! 788: IVTNUM = 26 07850311 ! 789: IF (ICZERO) 30260, 0260, 30260 07860311 ! 790: 0260 CONTINUE 07870311 ! 791: RVCOMP = 10.0 07880311 ! 792: RVCOMP = RFOS08(4.0) 07890311 ! 793: RVCORR = 0.8 07900311 ! 794: 40260 IF (RVCOMP - .79995) 20260, 10260, 40261 07910311 ! 795: 40261 IF (RVCOMP - .80005) 10260, 10260, 20260 07920311 ! 796: 30260 IVDELE = IVDELE + 1 07930311 ! 797: WRITE (I02,80000) IVTNUM 07940311 ! 798: IF (ICZERO) 10260, 0271, 20260 07950311 ! 799: 10260 IVPASS = IVPASS + 1 07960311 ! 800: WRITE (I02,80002) IVTNUM 07970311 ! 801: GO TO 0271 07980311 ! 802: 20260 IVFAIL = IVFAIL + 1 07990311 ! 803: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08000311 ! 804: 0271 CONTINUE 08010311 ! 805: C 08020311 ! 806: C **** FCVS PROGRAM 311 - TEST 027 **** 08030311 ! 807: C 08040311 ! 808: C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08050311 ! 809: C ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF INTEGER. 08060311 ! 810: C 08070311 ! 811: IVTNUM = 27 08080311 ! 812: IF (ICZERO) 30270, 0270, 30270 08090311 ! 813: 0270 CONTINUE 08100311 ! 814: RVCOMP = 10.0 08110311 ! 815: RVCOMP = RFOS09(4) 08120311 ! 816: RVCORR = 0.0 08130311 ! 817: 40270 IF (RVCOMP + .00005) 20270, 10270, 40271 08140311 ! 818: 40271 IF (RVCOMP - .00005) 10270, 10270, 20270 08150311 ! 819: 30270 IVDELE = IVDELE + 1 08160311 ! 820: WRITE (I02,80000) IVTNUM 08170311 ! 821: IF (ICZERO) 10270, 0281, 20270 08180311 ! 822: 10270 IVPASS = IVPASS + 1 08190311 ! 823: WRITE (I02,80002) IVTNUM 08200311 ! 824: GO TO 0281 08210311 ! 825: 20270 IVFAIL = IVFAIL + 1 08220311 ! 826: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08230311 ! 827: 0281 CONTINUE 08240311 ! 828: C 08250311 ! 829: C **** FCVS PROGRAM 311 - TEST 028 **** 08260311 ! 830: C 08270311 ! 831: C OVERRIDE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08280311 ! 832: C ARGUMENT WITH TYPE-STATEMENT TYPING OF REAL. 08290311 ! 833: C 08300311 ! 834: IVTNUM = 28 08310311 ! 835: IF (ICZERO) 30280, 0280, 30280 08320311 ! 836: 0280 CONTINUE 08330311 ! 837: RVCOMP = 10.0 08340311 ! 838: RVCOMP = RFOS10(4.0) 08350311 ! 839: RVCORR = 0.8 08360311 ! 840: 40280 IF (RVCOMP - .79995) 20280, 10280, 40281 08370311 ! 841: 40281 IF (RVCOMP - .80005) 10280, 10280, 20280 08380311 ! 842: 30280 IVDELE = IVDELE + 1 08390311 ! 843: WRITE (I02,80000) IVTNUM 08400311 ! 844: IF (ICZERO) 10280, 0291, 20280 08410311 ! 845: 10280 IVPASS = IVPASS + 1 08420311 ! 846: WRITE (I02,80002) IVTNUM 08430311 ! 847: GO TO 0291 08440311 ! 848: 20280 IVFAIL = IVFAIL + 1 08450311 ! 849: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08460311 ! 850: 0291 CONTINUE 08470311 ! 851: C 08480311 ! 852: C **** FCVS PROGRAM 311 - TEST 029 **** 08490311 ! 853: C 08500311 ! 854: C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08510311 ! 855: C ARGUMENT WITH TYPE-STATEMENT TYPING OF INTEGER. 08520311 ! 856: C 08530311 ! 857: IVTNUM = 29 08540311 ! 858: IF (ICZERO) 30290, 0290, 30290 08550311 ! 859: 0290 CONTINUE 08560311 ! 860: RVCOMP = 10.0 08570311 ! 861: RVCOMP = RFOS11(4) 08580311 ! 862: RVCORR = 0.0 08590311 ! 863: 40290 IF (RVCOMP + .00005) 20290, 10290, 40291 08600311 ! 864: 40291 IF (RVCOMP - .00005) 10290, 10290, 20290 08610311 ! 865: 30290 IVDELE = IVDELE + 1 08620311 ! 866: WRITE (I02,80000) IVTNUM 08630311 ! 867: IF (ICZERO) 10290, 0301, 20290 08640311 ! 868: 10290 IVPASS = IVPASS + 1 08650311 ! 869: WRITE (I02,80002) IVTNUM 08660311 ! 870: GO TO 0301 08670311 ! 871: 20290 IVFAIL = IVFAIL + 1 08680311 ! 872: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08690311 ! 873: 0301 CONTINUE 08700311 ! 874: C 08710311 ! 875: C **** FCVS PROGRAM 311 - TEST 030 **** 08720311 ! 876: C 08730311 ! 877: C TEST 030 TESTS A STATEMENT FUNCTION WHERE THE DUMMY ARGUMENT 08740311 ! 878: C NAME IS IDENTICAL TO A VARIABLE NAME WITHIN THE PROGRAM. 08750311 ! 879: C 08760311 ! 880: IVTNUM = 30 08770311 ! 881: IF (ICZERO) 30300, 0300, 30300 08780311 ! 882: 0300 CONTINUE 08790311 ! 883: IVON04 = 10 08800311 ! 884: IVCOMP = 1 08810311 ! 885: IF (IFOS15(3) .EQ. 4) IVCOMP = IVCOMP * 2 08820311 ! 886: IF (IVON04 .EQ. 10) IVCOMP = IVCOMP * 3 08830311 ! 887: IVCORR = 6 08840311 ! 888: C 6 = 2 * 3 08850311 ! 889: 40300 IF (IVCOMP - 6) 20300, 10300, 20300 08860311 ! 890: 30300 IVDELE = IVDELE + 1 08870311 ! 891: WRITE (I02,80000) IVTNUM 08880311 ! 892: IF (ICZERO) 10300, 0311, 20300 08890311 ! 893: 10300 IVPASS = IVPASS + 1 08900311 ! 894: WRITE (I02,80002) IVTNUM 08910311 ! 895: GO TO 0311 08920311 ! 896: 20300 IVFAIL = IVFAIL + 1 08930311 ! 897: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08940311 ! 898: 0311 CONTINUE 08950311 ! 899: C 08960311 ! 900: C **** FCVS PROGRAM 311 - TEST 031 **** 08970311 ! 901: C 08980311 ! 902: C TEST 031 TESTS THE ASSIGNMENT OF A STATEMENT FUNCTION TO AN 08990311 ! 903: C ARRAY ELEMENT. 09000311 ! 904: C 09010311 ! 905: IVTNUM = 31 09020311 ! 906: IF (ICZERO) 30310, 0310, 30310 09030311 ! 907: 0310 CONTINUE 09040311 ! 908: IVCOMP = 0 09050311 ! 909: IADN12(3) = IFOS16(4) 09060311 ! 910: IVCOMP = IADN12(3) 09070311 ! 911: IVCORR = 5 09080311 ! 912: 40310 IF (IVCOMP - 5) 20310, 10310, 20310 09090311 ! 913: 30310 IVDELE = IVDELE + 1 09100311 ! 914: WRITE (I02,80000) IVTNUM 09110311 ! 915: IF (ICZERO) 10310, 0321, 20310 09120311 ! 916: 10310 IVPASS = IVPASS + 1 09130311 ! 917: WRITE (I02,80002) IVTNUM 09140311 ! 918: GO TO 0321 09150311 ! 919: 20310 IVFAIL = IVFAIL + 1 09160311 ! 920: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09170311 ! 921: 0321 CONTINUE 09180311 ! 922: C 09190311 ! 923: C **** FCVS PROGRAM 311 - TEST 032 **** 09200311 ! 924: C 09210311 ! 925: C TEST 032 TESTS THE USE OF A STATEMENT FUNCTION REFERENCE 09220311 ! 926: C IN AN ARITHMETIC EXPRESSION. 09230311 ! 927: C 09240311 ! 928: IVTNUM = 32 09250311 ! 929: IF (ICZERO) 30320, 0320, 30320 09260311 ! 930: 0320 CONTINUE 09270311 ! 931: IVCOMP = 0 09280311 ! 932: IVON05 = 12 09290311 ! 933: IVCOMP = IVON05 + IFOS17(4) * 2 - 3 09300311 ! 934: IVCORR = 19 09310311 ! 935: 40320 IF (IVCOMP - 19) 20320, 10320, 20320 09320311 ! 936: 30320 IVDELE = IVDELE + 1 09330311 ! 937: WRITE (I02,80000) IVTNUM 09340311 ! 938: IF (ICZERO) 10320, 0331, 20320 09350311 ! 939: 10320 IVPASS = IVPASS + 1 09360311 ! 940: WRITE (I02,80002) IVTNUM 09370311 ! 941: GO TO 0331 09380311 ! 942: 20320 IVFAIL = IVFAIL + 1 09390311 ! 943: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09400311 ! 944: 0331 CONTINUE 09410311 ! 945: C 09420311 ! 946: C **** FCVS PROGRAM 311 - TEST 033 **** 09430311 ! 947: C 09440311 ! 948: C TEST 033 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND 09450311 ! 949: C REFERENCE WITHIN AN EXTERNAL FUNCTION. 09460311 ! 950: C 09470311 ! 951: IVTNUM = 33 09480311 ! 952: IF (ICZERO) 30330, 0330, 30330 09490311 ! 953: 0330 CONTINUE 09500311 ! 954: RVCOMP = 0.0 09510311 ! 955: RVCOMP = FF313(1.3) 09520311 ! 956: RVCORR = 5.8 09530311 ! 957: 40330 IF (RVCOMP - 5.7995) 20330, 10330, 40331 09540311 ! 958: 40331 IF (RVCOMP - 5.8005) 10330, 10330, 20330 09550311 ! 959: 30330 IVDELE = IVDELE + 1 09560311 ! 960: WRITE (I02,80000) IVTNUM 09570311 ! 961: IF (ICZERO) 10330, 0341, 20330 09580311 ! 962: 10330 IVPASS = IVPASS + 1 09590311 ! 963: WRITE (I02,80002) IVTNUM 09600311 ! 964: GO TO 0341 09610311 ! 965: 20330 IVFAIL = IVFAIL + 1 09620311 ! 966: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09630311 ! 967: 0341 CONTINUE 09640311 ! 968: C 09650311 ! 969: C **** FCVS PROGRAM 311 - TEST 034 **** 09660311 ! 970: C 09670311 ! 971: C TEST 034 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND 09680311 ! 972: C REFERENCE WITHIN A SUBROUTINE. 09690311 ! 973: C 09700311 ! 974: IVTNUM = 34 09710311 ! 975: IF (ICZERO) 30340, 0340, 30340 09720311 ! 976: 0340 CONTINUE 09730311 ! 977: RVCOMP = 0.0 09740311 ! 978: RVON05 = 10.0 09750311 ! 979: CALL FS316(RVON05) 09760311 ! 980: RVCOMP = RVON05 09770311 ! 981: RVCORR = 5.5 09780311 ! 982: 40340 IF (RVCOMP - 5.4995) 20340, 10340, 40341 09790311 ! 983: 40341 IF (RVCOMP - 5.5005) 10340, 10340, 20340 09800311 ! 984: 30340 IVDELE = IVDELE + 1 09810311 ! 985: WRITE (I02,80000) IVTNUM 09820311 ! 986: IF (ICZERO) 10340, 0351, 20340 09830311 ! 987: 10340 IVPASS = IVPASS + 1 09840311 ! 988: WRITE (I02,80002) IVTNUM 09850311 ! 989: GO TO 0351 09860311 ! 990: 20340 IVFAIL = IVFAIL + 1 09870311 ! 991: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09880311 ! 992: 0351 CONTINUE 09890311 ! 993: C 09900311 ! 994: C **** FCVS PROGRAM 311 - TEST 035 **** 09910311 ! 995: C 09920311 ! 996: C TEST 035 REFERENCES THE DUMMY ARGUMENT NAME OF AN EXTERNAL 09930311 ! 997: C FUNCTION WITHIN THE EXPRESSION OF A STATEMENT FUNCTION DEFINED 09940311 ! 998: C IN THAT EXTERNAL FUNCTION. 09950311 ! 999: C 09960311 ! 1000: IVTNUM = 35 09970311 ! 1001: IF (ICZERO) 30350, 0350, 30350 09980311 ! 1002: 0350 CONTINUE 09990311 ! 1003: IVCOMP = 0 10000311 ! 1004: IVCOMP = FF314(4) 10010311 ! 1005: IVCORR = 7 10020311 ! 1006: 40350 IF (IVCOMP - 7) 20350, 10350, 20350 10030311 ! 1007: 30350 IVDELE = IVDELE + 1 10040311 ! 1008: WRITE (I02,80000) IVTNUM 10050311 ! 1009: IF (ICZERO) 10350, 0361, 20350 10060311 ! 1010: 10350 IVPASS = IVPASS + 1 10070311 ! 1011: WRITE (I02,80002) IVTNUM 10080311 ! 1012: GO TO 0361 10090311 ! 1013: 20350 IVFAIL = IVFAIL + 1 10100311 ! 1014: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10110311 ! 1015: 0361 CONTINUE 10120311 ! 1016: C 10130311 ! 1017: C **** FCVS PROGRAM 311 - TEST 036 **** 10140311 ! 1018: C 10150311 ! 1019: C TEST 036 TESTS A STATEMENT FUNCTION DEFINED WITHIN AN EXTERNAL 10160311 ! 1020: C FUNCTION IN WHICH THE STATEMENT FUNCTION DUMMY ARGUMENT NAME IS 10170311 ! 1021: C IDENTICAL TO THE EXTERNAL FUNCTION DUMMY ARGUMENT NAME. 10180311 ! 1022: C 10190311 ! 1023: IVTNUM = 36 10200311 ! 1024: IF (ICZERO) 30360, 0360, 30360 10210311 ! 1025: 0360 CONTINUE 10220311 ! 1026: RVCOMP = 0.0 10230311 ! 1027: RVCOMP = FF315(5.5) 10240311 ! 1028: RVCORR = 16.7 10250311 ! 1029: 40360 IF (RVCOMP - 16.695) 20360, 10360, 40361 10260311 ! 1030: 40361 IF (RVCOMP - 16.705) 10360, 10360, 20360 10270311 ! 1031: 30360 IVDELE = IVDELE + 1 10280311 ! 1032: WRITE (I02,80000) IVTNUM 10290311 ! 1033: IF (ICZERO) 10360, 0371, 20360 10300311 ! 1034: 10360 IVPASS = IVPASS + 1 10310311 ! 1035: WRITE (I02,80002) IVTNUM 10320311 ! 1036: GO TO 0371 10330311 ! 1037: 20360 IVFAIL = IVFAIL + 1 10340311 ! 1038: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 10350311 ! 1039: 0371 CONTINUE 10360311 ! 1040: C 10370311 ! 1041: C **** FCVS PROGRAM 311 - TEST 037 **** 10380311 ! 1042: C 10390311 ! 1043: C TEST 037 TESTS THE USAGE OF THE NAME OF A COMMON BLOCK AS THE 10400311 ! 1044: C SYMBOLIC NAME OF A STATEMENT FUNCTION. 10410311 ! 1045: C 10420311 ! 1046: IVTNUM = 37 10430311 ! 1047: IF (ICZERO) 30370, 0370, 30370 10440311 ! 1048: 0370 CONTINUE 10450311 ! 1049: IVCOMP = 0 10460311 ! 1050: IVCOMP = IFOS19(4) 10470311 ! 1051: IVCORR = 5 10480311 ! 1052: 40370 IF (IVCOMP - 5) 20370, 10370, 20370 10490311 ! 1053: 30370 IVDELE = IVDELE + 1 10500311 ! 1054: WRITE (I02,80000) IVTNUM 10510311 ! 1055: IF (ICZERO) 10370, 0381, 20370 10520311 ! 1056: 10370 IVPASS = IVPASS + 1 10530311 ! 1057: WRITE (I02,80002) IVTNUM 10540311 ! 1058: GO TO 0381 10550311 ! 1059: 20370 IVFAIL = IVFAIL + 1 10560311 ! 1060: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10570311 ! 1061: 0381 CONTINUE 10580311 ! 1062: C 10590311 ! 1063: C 10600311 ! 1064: C WRITE OUT TEST SUMMARY 10610311 ! 1065: C 10620311 ! 1066: WRITE (I02,90004) 10630311 ! 1067: WRITE (I02,90014) 10640311 ! 1068: WRITE (I02,90004) 10650311 ! 1069: WRITE (I02,90000) 10660311 ! 1070: WRITE (I02,90004) 10670311 ! 1071: WRITE (I02,90020) IVFAIL 10680311 ! 1072: WRITE (I02,90022) IVPASS 10690311 ! 1073: WRITE (I02,90024) IVDELE 10700311 ! 1074: STOP 10710311 ! 1075: 90001 FORMAT (1H ,24X,5HFM311) 10720311 ! 1076: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM311) 10730311 ! 1077: C 10740311 ! 1078: C FORMATS FOR TEST DETAIL LINES 10750311 ! 1079: C 10760311 ! 1080: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 10770311 ! 1081: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 10780311 ! 1082: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 10790311 ! 1083: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 10800311 ! 1084: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 10810311 ! 1085: C 10820311 ! 1086: C FORMAT STATEMENTS FOR PAGE HEADERS 10830311 ! 1087: C 10840311 ! 1088: 90002 FORMAT (1H1) 10850311 ! 1089: 90004 FORMAT (1H ) 10860311 ! 1090: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 10870311 ! 1091: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 10880311 ! 1092: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 10890311 ! 1093: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 10900311 ! 1094: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 10910311 ! 1095: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 10920311 ! 1096: C 10930311 ! 1097: C FORMAT STATEMENTS FOR RUN SUMMARY 10940311 ! 1098: C 10950311 ! 1099: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 10960311 ! 1100: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 10970311 ! 1101: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 10980311 ! 1102: END 10990311 ! 1103: INTEGER FUNCTION FF312(IDONX1) 00010312 ! 1104: C DATE***82/08/02*18.33.46 ! 1105: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 1106: C AUDIT FCVS78 V2.0 ! 1107: C THIS SUBPROGRAM IS USED BY TESTS 014 AND 023 OF THE MAIN PROGRAM 00020312 ! 1108: C FM311 TO TEST STATEMENT FUNCTION. IN TEST 014 REFERENCE TO FF312 00030312 ! 1109: C IS USED IN THE EXPRESSION OF A STATEMENT FUNCTION. IN TEST 023 00040312 ! 1110: C REFERENCE TO FF312 IS USED AS AN ACTUAL ARGUMENT IN A STATEMENT 00050312 ! 1111: C FUNCTION REFERENCE. THIS ROUTINE MERELY INCREMENTS THE VALUE OF 00060312 ! 1112: C ACTUAL/DUMMY ARGUMENT BY ONE AND RETURN THE RESULT AS THE 00070312 ! 1113: C FUNCTION VALUE. 00080312 ! 1114: IDONX2 = IDONX1 + 1 00090312 ! 1115: FF312 = IDONX2 00100312 ! 1116: RETURN 00110312 ! 1117: END 00120312 ! 1118: REAL FUNCTION FF313(RDON08) 00010313 ! 1119: C DATE***82/08/02*18.33.46 ! 1120: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 1121: C AUDIT FCVS78 V2.0 ! 1122: C THIS SUBPROGRAM IS USED BY TEST 033 OF THE MAIN PROGRAM FM311 TO 00020313 ! 1123: C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030313 ! 1124: C AN EXTERNAL FUNCTION. 00040313 ! 1125: RFOS12(RDON09) = RDON09 + 1.0 00050313 ! 1126: RVON04 = RFOS12(3.5) 00060313 ! 1127: FF313 = RDON08 + RVON04 00070313 ! 1128: RETURN 00080313 ! 1129: END 00090313 ! 1130: INTEGER FUNCTION FF314(IDON19) 00010314 ! 1131: C DATE***82/08/02*18.33.46 ! 1132: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 1133: C AUDIT FCVS78 V2.0 ! 1134: C THIS SUBPROGRAM IS USED BY TEST 035 OF THE MAIN PROGRAM FM311 TO 00020314 ! 1135: C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030314 ! 1136: C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION DUMMY 00040314 ! 1137: C ARGUMENT IS REFERENCED WITHIN THE EXPRESSION OF THE STATEMENT 00050314 ! 1138: C FUNCTION. 00060314 ! 1139: IFOS18(IDON20) = IDON19 + IDON20 00070314 ! 1140: FF314 = IFOS18(3) 00080314 ! 1141: RETURN 00090314 ! 1142: END 00100314 ! 1143: REAL FUNCTION FF315(RDON12) 00010315 ! 1144: C DATE***82/08/02*18.33.46 ! 1145: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 1146: C AUDIT FCVS78 V2.0 ! 1147: C THIS SUBPROGRAM IS USED BY TEST 036 OF THE MAIN PROGRAM FM311 TO 00020315 ! 1148: C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030315 ! 1149: C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION AND 00040315 ! 1150: C STATEMENT FUNCTION DUMMY ARGUMENTS NAMES ARE IDENTICAL. 00050315 ! 1151: RFOS14(RDON12) = RDON12 + 1.0 00060315 ! 1152: RVON06 = 10.2 00070315 ! 1153: RVON07 = RFOS14(RVON06) 00080315 ! 1154: FF315 = RDON12 + RVON07 00090315 ! 1155: RETURN 00100315 ! 1156: END 00110315 ! 1157: SUBROUTINE FS316(RDON10) 00010316 ! 1158: C DATE***82/08/02*18.33.46 ! 1159: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 1160: C AUDIT FCVS78 V2.0 ! 1161: C THIS SUBPROGRAM IS USED BY TEST 034 OF THE MAIN PROGRAM FM311 TO 00020316 ! 1162: C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030316 ! 1163: C A SUBROUTINE. 00040316 ! 1164: RFOS13(RDON11) = RDON11 + 1.0 00050316 ! 1165: RDON10 = RFOS13(3.5) + 1.0 00060316 ! 1166: RETURN 00070316 ! 1167: END 00080316
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.