|
|
1.1 ! root 1: C COMMENT SECTION 00010097 ! 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 00020097 ! 6: C FM097 00030097 ! 7: C 00040097 ! 8: C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION TYPE IS 00050097 ! 9: C REAL AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE REAL AND 00060097 ! 10: C INTEGER VARIABLES AND THE REAL AND INTEGER CONSTANTS CONTAIN BOTH 00070097 ! 11: C POSITIVE AND NEGATIVE VALUES. THE INTRINSIC FUNCTIONS TESTED BY 00080097 ! 12: C FM097 INCLUDE 00090097 ! 13: C TYPE OF 00100097 ! 14: C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION 00110097 ! 15: C ------------------ ---- -------- -------- 00120097 ! 16: C ABSOLUTE VALUE ABS REAL REAL 00130097 ! 17: C TRUNCATION AINT REAL REAL 00140097 ! 18: C REMAINDERING AMOD REAL REAL 00150097 ! 19: C CHOOSING LARGEST VALUE AMAX0 INTEGER REAL 00160097 ! 20: C AMAX1 REAL REAL 00170097 ! 21: C CHOOSING SMALLEST VALUE AMIN0 INTEGER REAL 00180097 ! 22: C AMIN1 REAL REAL 00190097 ! 23: C FLOAT FLOAT INTEGER REAL 00200097 ! 24: C TRANSFER OF SIGN SIGN REAL REAL 00210097 ! 25: C POSITIVE DIFFERENCE DIM REAL REAL 00220097 ! 26: C 00230097 ! 27: C REFERENCES 00240097 ! 28: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00250097 ! 29: C X3.9-1978 00260097 ! 30: C 00270097 ! 31: C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS 00280097 ! 32: C SECTION 15.3, INTRINSIC FUNCTION 00290097 ! 33: C SECTION 15.3.2, INTRINSIC FUNCTIONS AND THEIR REFERENCE 00300097 ! 34: C 00310097 ! 35: C 00320097 ! 36: C ********************************************************** 00330097 ! 37: C 00340097 ! 38: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00350097 ! 39: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00360097 ! 40: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00370097 ! 41: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00380097 ! 42: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00390097 ! 43: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00400097 ! 44: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00410097 ! 45: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00420097 ! 46: C OF EXECUTING THESE TESTS. 00430097 ! 47: C 00440097 ! 48: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00450097 ! 49: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00460097 ! 50: C 00470097 ! 51: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00480097 ! 52: C 00490097 ! 53: C DEPARTMENT OF THE NAVY 00500097 ! 54: C FEDERAL COBOL COMPILER TESTING SERVICE 00510097 ! 55: C WASHINGTON, D.C. 20376 00520097 ! 56: C 00530097 ! 57: C ********************************************************** 00540097 ! 58: C 00550097 ! 59: C 00560097 ! 60: C 00570097 ! 61: C INITIALIZATION SECTION 00580097 ! 62: C 00590097 ! 63: C INITIALIZE CONSTANTS 00600097 ! 64: C ************** 00610097 ! 65: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620097 ! 66: I01 = 5 00630097 ! 67: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640097 ! 68: I02 = 6 00650097 ! 69: C SYSTEM ENVIRONMENT SECTION 00660097 ! 70: C 00670097 ! 71: I01 = 5 00680097 ! 72: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690097 ! 73: C (UNIT NUMBER FOR CARD READER). 00700097 ! 74: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00710097 ! 75: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00720097 ! 76: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00730097 ! 77: C 00740097 ! 78: I02 = 6 00750097 ! 79: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00760097 ! 80: C (UNIT NUMBER FOR PRINTER). 00770097 ! 81: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00780097 ! 82: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00790097 ! 83: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00800097 ! 84: C 00810097 ! 85: IVPASS=0 00820097 ! 86: IVFAIL=0 00830097 ! 87: IVDELE=0 00840097 ! 88: ICZERO=0 00850097 ! 89: C 00860097 ! 90: C WRITE PAGE HEADERS 00870097 ! 91: WRITE (I02,90000) 00880097 ! 92: WRITE (I02,90001) 00890097 ! 93: WRITE (I02,90002) 00900097 ! 94: WRITE (I02, 90002) 00910097 ! 95: WRITE (I02,90003) 00920097 ! 96: WRITE (I02,90002) 00930097 ! 97: WRITE (I02,90004) 00940097 ! 98: WRITE (I02,90002) 00950097 ! 99: WRITE (I02,90011) 00960097 ! 100: WRITE (I02,90002) 00970097 ! 101: WRITE (I02,90002) 00980097 ! 102: WRITE (I02,90005) 00990097 ! 103: WRITE (I02,90006) 01000097 ! 104: WRITE (I02,90002) 01010097 ! 105: C 01020097 ! 106: C TEST SECTION 01030097 ! 107: C 01040097 ! 108: C TEST 875 THROUGH TEST 878 CONTAIN INTRINSIC FUNCTION TESTS FOR 01050097 ! 109: C ABSOLUTE VALUE WHERE ARGUMENT AND FUNCTION ARE REAL 01060097 ! 110: C 01070097 ! 111: IVTNUM = 875 01080097 ! 112: C 01090097 ! 113: C **** TEST 875 **** 01100097 ! 114: C 01110097 ! 115: IF (ICZERO) 38750, 8750, 38750 01120097 ! 116: 8750 CONTINUE 01130097 ! 117: RVCOMP = ABS (-38.2) 01140097 ! 118: GO TO 48750 01150097 ! 119: 38750 IVDELE = IVDELE + 1 01160097 ! 120: WRITE (I02,80003) IVTNUM 01170097 ! 121: IF (ICZERO) 48750, 8761, 48750 01180097 ! 122: 48750 IF (RVCOMP - 38.195) 28750,18750,48751 01190097 ! 123: 48751 IF (RVCOMP - 38.205) 18750,18750,28750 01200097 ! 124: 18750 IVPASS = IVPASS + 1 01210097 ! 125: WRITE (I02,80001) IVTNUM 01220097 ! 126: GO TO 8761 01230097 ! 127: 28750 IVFAIL = IVFAIL + 1 01240097 ! 128: RVCORR = 38.200 01250097 ! 129: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01260097 ! 130: 8761 CONTINUE 01270097 ! 131: IVTNUM = 876 01280097 ! 132: C 01290097 ! 133: C **** TEST 876 **** 01300097 ! 134: C 01310097 ! 135: IF (ICZERO) 38760, 8760, 38760 01320097 ! 136: 8760 CONTINUE 01330097 ! 137: RVON01 = 445.06 01340097 ! 138: RVCOMP = ABS (RVON01) 01350097 ! 139: GO TO 48760 01360097 ! 140: 38760 IVDELE = IVDELE + 1 01370097 ! 141: WRITE (I02,80003) IVTNUM 01380097 ! 142: IF (ICZERO) 48760, 8771, 48760 01390097 ! 143: 48760 IF (RVCOMP - 445.01) 28760,18760,48761 01400097 ! 144: 48761 IF (RVCOMP - 445.11) 18760,18760,28760 01410097 ! 145: 18760 IVPASS = IVPASS + 1 01420097 ! 146: WRITE (I02,80001) IVTNUM 01430097 ! 147: GO TO 8771 01440097 ! 148: 28760 IVFAIL = IVFAIL + 1 01450097 ! 149: RVCORR = 445.06 01460097 ! 150: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01470097 ! 151: 8771 CONTINUE 01480097 ! 152: IVTNUM = 877 01490097 ! 153: C 01500097 ! 154: C **** TEST 877 **** 01510097 ! 155: C 01520097 ! 156: IF (ICZERO) 38770, 8770, 38770 01530097 ! 157: 8770 CONTINUE 01540097 ! 158: RVON01 = -32.176 01550097 ! 159: RVCOMP = ABS (RVON01) 01560097 ! 160: GO TO 48770 01570097 ! 161: 38770 IVDELE = IVDELE + 1 01580097 ! 162: WRITE (I02,80003) IVTNUM 01590097 ! 163: IF (ICZERO) 48770, 8781, 48770 01600097 ! 164: 48770 IF (RVCOMP - 32.171) 28770,18770,48771 01610097 ! 165: 48771 IF (RVCOMP - 32.181) 18770,18770,28770 01620097 ! 166: 18770 IVPASS = IVPASS + 1 01630097 ! 167: WRITE (I02,80001) IVTNUM 01640097 ! 168: GO TO 8781 01650097 ! 169: 28770 IVFAIL = IVFAIL + 1 01660097 ! 170: RVCORR = 32.176 01670097 ! 171: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01680097 ! 172: 8781 CONTINUE 01690097 ! 173: IVTNUM = 878 01700097 ! 174: C 01710097 ! 175: C **** TEST 878 **** 01720097 ! 176: C 01730097 ! 177: IF (ICZERO) 38780, 8780, 38780 01740097 ! 178: 8780 CONTINUE 01750097 ! 179: RVON01 = -2.2E+2 01760097 ! 180: RVCOMP = ABS (RVON01) 01770097 ! 181: GO TO 48780 01780097 ! 182: 38780 IVDELE = IVDELE + 1 01790097 ! 183: WRITE (I02,80003) IVTNUM 01800097 ! 184: IF (ICZERO) 48780, 8791, 48780 01810097 ! 185: 48780 IF (RVCOMP - 219.95) 28780,18780,48781 01820097 ! 186: 48781 IF (RVCOMP - 220.05) 18780,18780,28780 01830097 ! 187: 18780 IVPASS = IVPASS + 1 01840097 ! 188: WRITE (I02,80001) IVTNUM 01850097 ! 189: GO TO 8791 01860097 ! 190: 28780 IVFAIL = IVFAIL + 1 01870097 ! 191: RVCORR = 220.00 01880097 ! 192: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01890097 ! 193: 8791 CONTINUE 01900097 ! 194: IVTNUM = 879 01910097 ! 195: C 01920097 ! 196: C **** TEST 879 **** 01930097 ! 197: C 01940097 ! 198: C TEST 879 THROUGH TEST 882 CONTAIN INTRINSIC FUNCTION TESTS FOR 01950097 ! 199: C TRUNCATION WHERE ARGUMENT AND FUNCTION ARE REAL 01960097 ! 200: C 01970097 ! 201: C 01980097 ! 202: IF (ICZERO) 38790, 8790, 38790 01990097 ! 203: 8790 CONTINUE 02000097 ! 204: RVCOMP = AINT (38.2) 02010097 ! 205: GO TO 48790 02020097 ! 206: 38790 IVDELE = IVDELE + 1 02030097 ! 207: WRITE (I02,80003) IVTNUM 02040097 ! 208: IF (ICZERO) 48790, 8801, 48790 02050097 ! 209: 48790 IF (RVCOMP - 37.995) 28790,18790,48791 02060097 ! 210: 48791 IF (RVCOMP - 38.005) 18790,18790,28790 02070097 ! 211: 18790 IVPASS = IVPASS + 1 02080097 ! 212: WRITE (I02,80001) IVTNUM 02090097 ! 213: GO TO 8801 02100097 ! 214: 28790 IVFAIL = IVFAIL + 1 02110097 ! 215: RVCORR = 38.000 02120097 ! 216: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02130097 ! 217: 8801 CONTINUE 02140097 ! 218: IVTNUM = 880 02150097 ! 219: C 02160097 ! 220: C **** TEST 880 **** 02170097 ! 221: C 02180097 ! 222: IF (ICZERO) 38800, 8800, 38800 02190097 ! 223: 8800 CONTINUE 02200097 ! 224: RVON01 = -445.95 02210097 ! 225: RVCOMP = AINT (RVON01) 02220097 ! 226: GO TO 48800 02230097 ! 227: 38800 IVDELE = IVDELE + 1 02240097 ! 228: WRITE (I02,80003) IVTNUM 02250097 ! 229: IF (ICZERO) 48800, 8811, 48800 02260097 ! 230: 48800 IF (RVCOMP + 445.05) 28800,18800,48801 02270097 ! 231: 48801 IF (RVCOMP + 444.95) 18800,18800,28800 02280097 ! 232: 18800 IVPASS = IVPASS + 1 02290097 ! 233: WRITE (I02,80001) IVTNUM 02300097 ! 234: GO TO 8811 02310097 ! 235: 28800 IVFAIL = IVFAIL + 1 02320097 ! 236: RVCORR = -445.00 02330097 ! 237: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02340097 ! 238: 8811 CONTINUE 02350097 ! 239: IVTNUM = 881 02360097 ! 240: C 02370097 ! 241: C **** TEST 881 **** 02380097 ! 242: C 02390097 ! 243: IF (ICZERO) 38810, 8810, 38810 02400097 ! 244: 8810 CONTINUE 02410097 ! 245: RVON01 = 466.01 02420097 ! 246: RVCOMP = AINT (RVON01) 02430097 ! 247: GO TO 48810 02440097 ! 248: 38810 IVDELE = IVDELE + 1 02450097 ! 249: WRITE (I02,80003) IVTNUM 02460097 ! 250: IF (ICZERO) 48810, 8821, 48810 02470097 ! 251: 48810 IF (RVCOMP - 465.95) 28810,18810,48811 02480097 ! 252: 48811 IF (RVCOMP - 466.05) 18810,18810,28810 02490097 ! 253: 18810 IVPASS = IVPASS + 1 02500097 ! 254: WRITE (I02,80001) IVTNUM 02510097 ! 255: GO TO 8821 02520097 ! 256: 28810 IVFAIL = IVFAIL + 1 02530097 ! 257: RVCOMP = 466.00 02540097 ! 258: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02550097 ! 259: 8821 CONTINUE 02560097 ! 260: IVTNUM = 882 02570097 ! 261: C 02580097 ! 262: C **** TEST 882 **** 02590097 ! 263: C 02600097 ! 264: IF (ICZERO) 38820, 8820, 38820 02610097 ! 265: 8820 CONTINUE 02620097 ! 266: RVON01 = 382E-1 02630097 ! 267: RVCOMP = AINT (RVON01) 02640097 ! 268: GO TO 48820 02650097 ! 269: 38820 IVDELE = IVDELE + 1 02660097 ! 270: WRITE (I02,80003) IVTNUM 02670097 ! 271: IF (ICZERO) 48820, 8831, 48820 02680097 ! 272: 48820 IF (RVCOMP - 37.995) 28820,18820,48821 02690097 ! 273: 48821 IF (RVCOMP - 38.005) 18820,18820,28820 02700097 ! 274: 18820 IVPASS = IVPASS + 1 02710097 ! 275: WRITE (I02,80001) IVTNUM 02720097 ! 276: GO TO 8831 02730097 ! 277: 28820 IVFAIL = IVFAIL + 1 02740097 ! 278: RVCORR = 38.000 02750097 ! 279: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02760097 ! 280: 8831 CONTINUE 02770097 ! 281: C 02780097 ! 282: C TEST 883 THROUGH 886 CONTAIN INTRINSIC FUNCTION TESTS FOR 02790097 ! 283: C REMAINDERING WHERE ARGUMENT AND FUNCTION ARE REAL 02800097 ! 284: C 02810097 ! 285: IVTNUM = 883 02820097 ! 286: C 02830097 ! 287: C **** TEST 883 **** 02840097 ! 288: C 02850097 ! 289: IF (ICZERO) 38830, 8830, 38830 02860097 ! 290: 8830 CONTINUE 02870097 ! 291: RVCOMP = AMOD (42.0,19.0) 02880097 ! 292: GO TO 48830 02890097 ! 293: 38830 IVDELE = IVDELE + 1 02900097 ! 294: WRITE (I02,80003) IVTNUM 02910097 ! 295: IF (ICZERO) 48830, 8841, 48830 02920097 ! 296: 48830 IF (RVCOMP - 3.9995) 28830,18830,48831 02930097 ! 297: 48831 IF (RVCOMP - 4.0005) 18830,18830,28830 02940097 ! 298: 18830 IVPASS = IVPASS + 1 02950097 ! 299: WRITE (I02,80001) IVTNUM 02960097 ! 300: GO TO 8841 02970097 ! 301: 28830 IVFAIL = IVFAIL + 1 02980097 ! 302: RVCORR = 4.0000 02990097 ! 303: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03000097 ! 304: 8841 CONTINUE 03010097 ! 305: IVTNUM = 884 03020097 ! 306: C 03030097 ! 307: C **** TEST 884 **** 03040097 ! 308: C 03050097 ! 309: IF (ICZERO) 38840, 8840, 38840 03060097 ! 310: 8840 CONTINUE 03070097 ! 311: RVON01 = 16.27 03080097 ! 312: RVON02 = 2.0 03090097 ! 313: RVCOMP = AMOD (RVON01,RVON02) 03100097 ! 314: GO TO 48840 03110097 ! 315: 38840 IVDELE = IVDELE + 1 03120097 ! 316: WRITE (I02,80003) IVTNUM 03130097 ! 317: IF (ICZERO) 48840, 8851, 48840 03140097 ! 318: 48840 IF (RVCOMP - .26995) 28840,18840,48841 03150097 ! 319: 48841 IF (RVCOMP - .27005) 18840,18840,28840 03160097 ! 320: 18840 IVPASS = IVPASS + 1 03170097 ! 321: WRITE (I02,80001) IVTNUM 03180097 ! 322: GO TO 8851 03190097 ! 323: 28840 IVFAIL = IVFAIL + 1 03200097 ! 324: RVCORR = .27000 03210097 ! 325: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03220097 ! 326: 8851 CONTINUE 03230097 ! 327: IVTNUM = 885 03240097 ! 328: C 03250097 ! 329: C **** TEST 885 **** 03260097 ! 330: C 03270097 ! 331: IF (ICZERO) 38850, 8850, 38850 03280097 ! 332: 8850 CONTINUE 03290097 ! 333: RVON01 = 225.0 03300097 ! 334: RVON02 = 5.0E1 03310097 ! 335: RVCOMP = AMOD (RVON01,RVON02) 03320097 ! 336: GO TO 48850 03330097 ! 337: 38850 IVDELE = IVDELE + 1 03340097 ! 338: WRITE (I02,80003) IVTNUM 03350097 ! 339: IF (ICZERO) 48850, 8861, 48850 03360097 ! 340: 48850 IF (RVCOMP - 24.995) 28850,18850,48851 03370097 ! 341: 48851 IF (RVCOMP - 25.005) 18850,18850,28850 03380097 ! 342: 18850 IVPASS = IVPASS + 1 03390097 ! 343: WRITE (I02,80001) IVTNUM 03400097 ! 344: GO TO 8861 03410097 ! 345: 28850 IVFAIL = IVFAIL + 1 03420097 ! 346: RVCORR = 25.000 03430097 ! 347: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03440097 ! 348: 8861 CONTINUE 03450097 ! 349: IVTNUM = 886 03460097 ! 350: C 03470097 ! 351: C **** TEST 886 **** 03480097 ! 352: C 03490097 ! 353: IF (ICZERO) 38860, 8860, 38860 03500097 ! 354: 8860 CONTINUE 03510097 ! 355: RVON01 = -0.390E+2 03520097 ! 356: RVON02 = 5E2 03530097 ! 357: RVCOMP = AMOD (RVON01,RVON02) 03540097 ! 358: GO TO 48860 03550097 ! 359: 38860 IVDELE = IVDELE + 1 03560097 ! 360: WRITE (I02,80003) IVTNUM 03570097 ! 361: IF (ICZERO) 48860, 8871, 48860 03580097 ! 362: 48860 IF (RVCOMP + 39.005) 28860,18860,48861 03590097 ! 363: 48861 IF (RVCOMP + 38.995) 18860,18860,28860 03600097 ! 364: 18860 IVPASS = IVPASS + 1 03610097 ! 365: WRITE (I02,80001) IVTNUM 03620097 ! 366: GO TO 8871 03630097 ! 367: 28860 IVFAIL = IVFAIL + 1 03640097 ! 368: RVCORR = -39.000 03650097 ! 369: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03660097 ! 370: 8871 CONTINUE 03670097 ! 371: C 03680097 ! 372: C TEST 887 AND 888 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 03690097 ! 373: C LARGEST VALUE WHERE ARGUMENTS ARE INTEGER AND FUNCTION IS REAL 03700097 ! 374: C 03710097 ! 375: IVTNUM = 887 03720097 ! 376: C 03730097 ! 377: C **** TEST 887 **** 03740097 ! 378: C 03750097 ! 379: IF (ICZERO) 38870, 8870, 38870 03760097 ! 380: 8870 CONTINUE 03770097 ! 381: IVON01 = 317 03780097 ! 382: IVON02 = -99 03790097 ! 383: IVON03 = 1 03800097 ! 384: RVCOMP = AMAX0 (263,IVON01,IVON02,IVON03) 03810097 ! 385: GO TO 48870 03820097 ! 386: 38870 IVDELE = IVDELE + 1 03830097 ! 387: WRITE (I02,80003) IVTNUM 03840097 ! 388: IF (ICZERO) 48870, 8881, 48870 03850097 ! 389: 48870 IF (RVCOMP - 316.95) 28870,18870,48871 03860097 ! 390: 48871 IF (RVCOMP - 317.05) 18870,18870,28870 03870097 ! 391: 18870 IVPASS = IVPASS + 1 03880097 ! 392: WRITE (I02,80001) IVTNUM 03890097 ! 393: GO TO 8881 03900097 ! 394: 28870 IVFAIL = IVFAIL + 1 03910097 ! 395: RVCORR = 317.00 03920097 ! 396: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03930097 ! 397: 8881 CONTINUE 03940097 ! 398: IVTNUM = 888 03950097 ! 399: C 03960097 ! 400: C **** TEST 888 **** 03970097 ! 401: C 03980097 ! 402: IF (ICZERO) 38880, 8880, 38880 03990097 ! 403: 8880 CONTINUE 04000097 ! 404: IVON01 = 2572 04010097 ! 405: IVON02 = 2570 04020097 ! 406: RVCOMP = AMAX0 (IVON01,IVON02) 04030097 ! 407: GO TO 48880 04040097 ! 408: 38880 IVDELE = IVDELE + 1 04050097 ! 409: WRITE (I02,80003) IVTNUM 04060097 ! 410: IF (ICZERO) 48880, 8891, 48880 04070097 ! 411: 48880 IF (RVCOMP - 2571.5) 28880,18880,48881 04080097 ! 412: 48881 IF (RVCOMP - 2572.5) 18880,18880,28880 04090097 ! 413: 18880 IVPASS = IVPASS + 1 04100097 ! 414: WRITE (I02,80001) IVTNUM 04110097 ! 415: GO TO 8891 04120097 ! 416: 28880 IVFAIL = IVFAIL + 1 04130097 ! 417: RVCORR = 2572.0 04140097 ! 418: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04150097 ! 419: 8891 CONTINUE 04160097 ! 420: C 04170097 ! 421: C TEST 889 AND 890 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04180097 ! 422: C LARGEST VALUE WHERE THE ARGUMENTS AND FUNCTION ARE REAL 04190097 ! 423: C 04200097 ! 424: IVTNUM = 889 04210097 ! 425: C 04220097 ! 426: C **** TEST 889 **** 04230097 ! 427: C 04240097 ! 428: IF (ICZERO) 38890, 8890, 38890 04250097 ! 429: 8890 CONTINUE 04260097 ! 430: RVON01 = .326E+2 04270097 ! 431: RVON02 = 22.075 04280097 ! 432: RVON03 = 76E-1 04290097 ! 433: RVCOMP = AMAX1 (RVON01,RVON02,RVON03) 04300097 ! 434: GO TO 48890 04310097 ! 435: 38890 IVDELE = IVDELE + 1 04320097 ! 436: WRITE (I02,80003) IVTNUM 04330097 ! 437: IF (ICZERO) 48890, 8901, 48890 04340097 ! 438: 48890 IF (RVCOMP - 32.595) 28890,18890,48891 04350097 ! 439: 48891 IF (RVCOMP - 32.605) 18890,18890,28890 04360097 ! 440: 18890 IVPASS = IVPASS + 1 04370097 ! 441: WRITE (I02,80001) IVTNUM 04380097 ! 442: GO TO 8901 04390097 ! 443: 28890 IVFAIL = IVFAIL + 1 04400097 ! 444: RVCORR = 32.600 04410097 ! 445: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04420097 ! 446: 8901 CONTINUE 04430097 ! 447: IVTNUM = 890 04440097 ! 448: C 04450097 ! 449: C **** TEST 890 **** 04460097 ! 450: C 04470097 ! 451: IF (ICZERO) 38900, 8900, 38900 04480097 ! 452: 8900 CONTINUE 04490097 ! 453: RVON01 = -6.3E2 04500097 ! 454: RVON02 = -21.0 04510097 ! 455: RVCOMP = AMAX1 (-463.3,RVON01,RVON02) 04520097 ! 456: GO TO 48900 04530097 ! 457: 38900 IVDELE = IVDELE + 1 04540097 ! 458: WRITE (I02,80003) IVTNUM 04550097 ! 459: IF (ICZERO) 48900, 8911, 48900 04560097 ! 460: 48900 IF (RVCOMP + 21.005) 28900,18900,48901 04570097 ! 461: 48901 IF (RVCOMP + 20.995) 18900,18900,28900 04580097 ! 462: 18900 IVPASS = IVPASS + 1 04590097 ! 463: WRITE (I02,80001) IVTNUM 04600097 ! 464: GO TO 8911 04610097 ! 465: 28900 IVFAIL = IVFAIL + 1 04620097 ! 466: RVCORR = -21.000 04630097 ! 467: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04640097 ! 468: 8911 CONTINUE 04650097 ! 469: C 04660097 ! 470: C TESTS 891 AND 892 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04670097 ! 471: C SMALLEST VALUE WHERE ARGUMENTS ARE INTEGER AND FUNCTION IS REAL 04680097 ! 472: C 04690097 ! 473: IVTNUM = 891 04700097 ! 474: C 04710097 ! 475: C **** TEST 891 **** 04720097 ! 476: C 04730097 ! 477: IF (ICZERO) 38910, 8910, 38910 04740097 ! 478: 8910 CONTINUE 04750097 ! 479: IVON01 = -75 04760097 ! 480: IVON02 = -243 04770097 ! 481: RVCOMP = AMIN0 (IVON01,IVON02) 04780097 ! 482: GO TO 48910 04790097 ! 483: 38910 IVDELE = IVDELE + 1 04800097 ! 484: WRITE (I02,80003) IVTNUM 04810097 ! 485: IF (ICZERO) 48910, 8921, 48910 04820097 ! 486: 48910 IF (RVCOMP + 243.05) 28910,18910,48911 04830097 ! 487: 48911 IF (RVCOMP + 242.95) 18910,18910,28910 04840097 ! 488: 18910 IVPASS = IVPASS + 1 04850097 ! 489: WRITE (I02,80001) IVTNUM 04860097 ! 490: GO TO 8921 04870097 ! 491: 28910 IVFAIL = IVFAIL + 1 04880097 ! 492: RVCORR = -243.00 04890097 ! 493: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04900097 ! 494: 8921 CONTINUE 04910097 ! 495: IVTNUM = 892 04920097 ! 496: C 04930097 ! 497: C **** TEST 892 **** 04940097 ! 498: C 04950097 ! 499: IF (ICZERO) 38920, 8920, 38920 04960097 ! 500: 8920 CONTINUE 04970097 ! 501: IVON01 = -11 04980097 ! 502: IVON02 = 11 04990097 ! 503: RVCOMP = AMIN0 (0,IVON01,IVON02) 05000097 ! 504: GO TO 48920 05010097 ! 505: 38920 IVDELE = IVDELE + 1 05020097 ! 506: WRITE (I02,80003) IVTNUM 05030097 ! 507: IF (ICZERO) 48920, 8931, 48920 05040097 ! 508: 48920 IF (RVCOMP + 11.005) 28920,18920,48921 05050097 ! 509: 48921 IF (RVCOMP + 10.995) 18920,18920,28920 05060097 ! 510: 18920 IVPASS = IVPASS + 1 05070097 ! 511: WRITE (I02,80001) IVTNUM 05080097 ! 512: GO TO 8931 05090097 ! 513: 28920 IVFAIL = IVFAIL + 1 05100097 ! 514: RVCORR = -11.000 05110097 ! 515: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05120097 ! 516: 8931 CONTINUE 05130097 ! 517: C 05140097 ! 518: C TESTS 893 AND 894 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 05150097 ! 519: C SMALLEST VALUE WHERE ARGUMENTS AND FUNCTION ARE REAL 05160097 ! 520: C 05170097 ! 521: IVTNUM = 893 05180097 ! 522: C 05190097 ! 523: C **** TEST 893 **** 05200097 ! 524: C 05210097 ! 525: IF (ICZERO) 38930, 8930, 38930 05220097 ! 526: 8930 CONTINUE 05230097 ! 527: RVON01 = 1.1111 05240097 ! 528: RVON02 = 22.222 05250097 ! 529: RVON03 = 333.33 05260097 ! 530: RVCOMP = AMIN1 (RVON01,RVON02,RVON03) 05270097 ! 531: GO TO 48930 05280097 ! 532: 38930 IVDELE = IVDELE + 1 05290097 ! 533: WRITE (I02,80003) IVTNUM 05300097 ! 534: IF (ICZERO) 48930, 8941, 48930 05310097 ! 535: 48930 IF (RVCOMP - 1.1106) 28930,18930,48931 05320097 ! 536: 48931 IF (RVCOMP - 1.1116) 18930,18930,28930 05330097 ! 537: 18930 IVPASS = IVPASS + 1 05340097 ! 538: WRITE (I02,80001) IVTNUM 05350097 ! 539: GO TO 8941 05360097 ! 540: 28930 IVFAIL = IVFAIL + 1 05370097 ! 541: RVCORR = 1.1111 05380097 ! 542: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05390097 ! 543: 8941 CONTINUE 05400097 ! 544: IVTNUM = 894 05410097 ! 545: C 05420097 ! 546: C **** TEST 894 **** 05430097 ! 547: C 05440097 ! 548: IF (ICZERO) 38940, 8940, 38940 05450097 ! 549: 8940 CONTINUE 05460097 ! 550: RVON01 = 28.8 05470097 ! 551: RVON02 = 2.88E1 05480097 ! 552: RVON03 = 288E-1 05490097 ! 553: RVON04 = 35.0 05500097 ! 554: RVCOMP = AMIN1 (RVON01,RVON02,RVON03,RVON04) 05510097 ! 555: GO TO 48940 05520097 ! 556: 38940 IVDELE = IVDELE + 1 05530097 ! 557: WRITE (I02,80003) IVTNUM 05540097 ! 558: IF (ICZERO) 48940, 8951, 48940 05550097 ! 559: 48940 IF (RVCOMP - 28.795) 28940,18940,48941 05560097 ! 560: 48941 IF (RVCOMP - 28.805) 18940,18940,28940 05570097 ! 561: 18940 IVPASS = IVPASS + 1 05580097 ! 562: WRITE (I02,80001) IVTNUM 05590097 ! 563: GO TO 8951 05600097 ! 564: 28940 IVFAIL = IVFAIL + 1 05610097 ! 565: RVCORR = 28.800 05620097 ! 566: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05630097 ! 567: 8951 CONTINUE 05640097 ! 568: C 05650097 ! 569: C TEST 895 THROUGH TEST 897 CONTAIN INTRINSIC FUNCTION TESTS FOR 05660097 ! 570: C FLOAT - CONVERSION OF AN INTEGER ARGUMENT TO REAL FUNCTION 05670097 ! 571: C 05680097 ! 572: IVTNUM = 895 05690097 ! 573: C 05700097 ! 574: C **** TEST 895 **** 05710097 ! 575: C 05720097 ! 576: IF (ICZERO) 38950, 8950, 38950 05730097 ! 577: 8950 CONTINUE 05740097 ! 578: RVCOMP = FLOAT (-606) 05750097 ! 579: GO TO 48950 05760097 ! 580: 38950 IVDELE = IVDELE + 1 05770097 ! 581: WRITE (I02,80003) IVTNUM 05780097 ! 582: IF (ICZERO) 48950, 8961, 48950 05790097 ! 583: 48950 IF (RVCOMP + 606.05) 28950,18950,48951 05800097 ! 584: 48951 IF (RVCOMP + 605.95) 18950,18950,28950 05810097 ! 585: 18950 IVPASS = IVPASS + 1 05820097 ! 586: WRITE (I02,80001) IVTNUM 05830097 ! 587: GO TO 8961 05840097 ! 588: 28950 IVFAIL = IVFAIL + 1 05850097 ! 589: RVCORR = -606.00 05860097 ! 590: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05870097 ! 591: 8961 CONTINUE 05880097 ! 592: IVTNUM = 896 05890097 ! 593: C 05900097 ! 594: C **** TEST 896 **** 05910097 ! 595: C 05920097 ! 596: IF (ICZERO) 38960, 8960, 38960 05930097 ! 597: 8960 CONTINUE 05940097 ! 598: IVON01 = 71 05950097 ! 599: RVCOMP = FLOAT (IVON01) 05960097 ! 600: GO TO 48960 05970097 ! 601: 38960 IVDELE = IVDELE + 1 05980097 ! 602: WRITE (I02,80003) IVTNUM 05990097 ! 603: IF (ICZERO) 48960, 8971, 48960 06000097 ! 604: 48960 IF (RVCOMP - 70.995) 28960,18960,48961 06010097 ! 605: 48961 IF (RVCOMP - 71.005) 18960,18960,28960 06020097 ! 606: 18960 IVPASS = IVPASS + 1 06030097 ! 607: WRITE (I02,80001) IVTNUM 06040097 ! 608: GO TO 8971 06050097 ! 609: 28960 IVFAIL = IVFAIL + 1 06060097 ! 610: RVCORR = 71.000 06070097 ! 611: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06080097 ! 612: 8971 CONTINUE 06090097 ! 613: IVTNUM = 897 06100097 ! 614: C 06110097 ! 615: C **** TEST 897 **** 06120097 ! 616: C 06130097 ! 617: IF (ICZERO) 38970, 8970, 38970 06140097 ! 618: 8970 CONTINUE 06150097 ! 619: IVON01 = 321 06160097 ! 620: RVCOMP = FLOAT (-IVON01) 06170097 ! 621: GO TO 48970 06180097 ! 622: 38970 IVDELE = IVDELE + 1 06190097 ! 623: WRITE (I02,80003) IVTNUM 06200097 ! 624: IF (ICZERO) 48970, 8981, 48970 06210097 ! 625: 48970 IF (RVCOMP + 321.05) 28970,18970,48971 06220097 ! 626: 48971 IF (RVCOMP + 320.95) 18970,18970,28970 06230097 ! 627: 18970 IVPASS = IVPASS + 1 06240097 ! 628: WRITE (I02,80001) IVTNUM 06250097 ! 629: GO TO 8981 06260097 ! 630: 28970 IVFAIL = IVFAIL + 1 06270097 ! 631: RVCORR = -321.00 06280097 ! 632: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06290097 ! 633: 8981 CONTINUE 06300097 ! 634: C 06310097 ! 635: C TEST 898 THROUGH TEST 900 CONTAIN INTRINSIC FUNCTION TESTS FOR 06320097 ! 636: C TRANSFER OF SIGN - BOTH ARGUMENTS AND FUNCTION ARE REAL 06330097 ! 637: C 06340097 ! 638: IVTNUM = 898 06350097 ! 639: C 06360097 ! 640: C **** TEST 898 **** 06370097 ! 641: C 06380097 ! 642: IF (ICZERO) 38980, 8980, 38980 06390097 ! 643: 8980 CONTINUE 06400097 ! 644: RVON01 = 64.3 06410097 ! 645: RVCOMP = SIGN (RVON01,-1.0) 06420097 ! 646: GO TO 48980 06430097 ! 647: 38980 IVDELE = IVDELE + 1 06440097 ! 648: WRITE (I02,80003) IVTNUM 06450097 ! 649: IF (ICZERO) 48980, 8991, 48980 06460097 ! 650: 48980 IF (RVCOMP + 64.305) 28980,18980,48981 06470097 ! 651: 48981 IF (RVCOMP + 64.295) 18980,18980,28980 06480097 ! 652: 18980 IVPASS = IVPASS + 1 06490097 ! 653: WRITE (I02,80001) IVTNUM 06500097 ! 654: GO TO 8991 06510097 ! 655: 28980 IVFAIL = IVFAIL + 1 06520097 ! 656: RVCORR = -64.300 06530097 ! 657: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06540097 ! 658: 8991 CONTINUE 06550097 ! 659: IVTNUM = 899 06560097 ! 660: C 06570097 ! 661: C **** TEST 899 **** 06580097 ! 662: C 06590097 ! 663: IF (ICZERO) 38990, 8990, 38990 06600097 ! 664: 8990 CONTINUE 06610097 ! 665: RVON01 = -2.2 06620097 ! 666: RVON02 = 7.23E1 06630097 ! 667: RVCOMP = SIGN (RVON01,RVON02) 06640097 ! 668: GO TO 48990 06650097 ! 669: 38990 IVDELE = IVDELE + 1 06660097 ! 670: WRITE (I02,80003) IVTNUM 06670097 ! 671: IF (ICZERO) 48990, 9001, 48990 06680097 ! 672: 48990 IF (RVCOMP - 2.1995) 28990,18990,48991 06690097 ! 673: 48991 IF (RVCOMP - 2.2005) 18990,18990,28990 06700097 ! 674: 18990 IVPASS = IVPASS + 1 06710097 ! 675: WRITE (I02,80001) IVTNUM 06720097 ! 676: GO TO 9001 06730097 ! 677: 28990 IVFAIL = IVFAIL + 1 06740097 ! 678: RVCORR = 2.2000 06750097 ! 679: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06760097 ! 680: 9001 CONTINUE 06770097 ! 681: IVTNUM = 900 06780097 ! 682: C 06790097 ! 683: C **** TEST 900 **** 06800097 ! 684: C 06810097 ! 685: IF (ICZERO) 39000, 9000, 39000 06820097 ! 686: 9000 CONTINUE 06830097 ! 687: RVON01 = 35.32E+1 06840097 ! 688: RVON02 = 1.0 06850097 ! 689: RVCOMP = SIGN (RVON01,RVON02) 06860097 ! 690: GO TO 49000 06870097 ! 691: 39000 IVDELE = IVDELE + 1 06880097 ! 692: WRITE (I02,80003) IVTNUM 06890097 ! 693: IF (ICZERO) 49000, 9011, 49000 06900097 ! 694: 49000 IF (RVCOMP - 353.15) 29000,19000,49001 06910097 ! 695: 49001 IF (RVCOMP - 353.25) 19000,19000,29000 06920097 ! 696: 19000 IVPASS = IVPASS + 1 06930097 ! 697: WRITE (I02,80001) IVTNUM 06940097 ! 698: GO TO 9011 06950097 ! 699: 29000 IVFAIL = IVFAIL + 1 06960097 ! 700: RVCORR = 353.20 06970097 ! 701: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06980097 ! 702: 9011 CONTINUE 06990097 ! 703: C 07000097 ! 704: C TEST 901 THROUGH TEST 904 CONTAIN INTRINSIC FUNCTION TESTS FOR 07010097 ! 705: C POSITIVE DIFFERENCE WHERE ARGUMENTS AND FUNCTION ARE REAL 07020097 ! 706: C 07030097 ! 707: IVTNUM = 901 07040097 ! 708: C 07050097 ! 709: C **** TEST 901 **** 07060097 ! 710: C 07070097 ! 711: IF (ICZERO) 39010, 9010, 39010 07080097 ! 712: 9010 CONTINUE 07090097 ! 713: RVON01 = 22.2 07100097 ! 714: RVCOMP = DIM (RVON01,1.0) 07110097 ! 715: GO TO 49010 07120097 ! 716: 39010 IVDELE = IVDELE + 1 07130097 ! 717: WRITE (I02,80003) IVTNUM 07140097 ! 718: IF (ICZERO) 49010, 9021, 49010 07150097 ! 719: 49010 IF (RVCOMP - 21.195) 29010,19010,49011 07160097 ! 720: 49011 IF (RVCOMP - 21.205) 19010,19010,29010 07170097 ! 721: 19010 IVPASS = IVPASS + 1 07180097 ! 722: WRITE (I02,80001) IVTNUM 07190097 ! 723: GO TO 9021 07200097 ! 724: 29010 IVFAIL = IVFAIL + 1 07210097 ! 725: RVCORR = 21.200 07220097 ! 726: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07230097 ! 727: 9021 CONTINUE 07240097 ! 728: IVTNUM = 902 07250097 ! 729: C 07260097 ! 730: C **** TEST 902 **** 07270097 ! 731: C 07280097 ! 732: IF (ICZERO) 39020, 9020, 39020 07290097 ! 733: 9020 CONTINUE 07300097 ! 734: RVON01 = 4.5E1 07310097 ! 735: RVON02 = 41.0 07320097 ! 736: RVCOMP = DIM (RVON01,RVON02) 07330097 ! 737: GO TO 49020 07340097 ! 738: 39020 IVDELE = IVDELE + 1 07350097 ! 739: WRITE (I02,80003) IVTNUM 07360097 ! 740: IF (ICZERO) 49020, 9031, 49020 07370097 ! 741: 49020 IF (RVCOMP - 3.9995) 29020,19020,49021 07380097 ! 742: 49021 IF (RVCOMP - 4.0005) 19020,19020,29020 07390097 ! 743: 19020 IVPASS = IVPASS + 1 07400097 ! 744: WRITE (I02,80001) IVTNUM 07410097 ! 745: GO TO 9031 07420097 ! 746: 29020 IVFAIL = IVFAIL + 1 07430097 ! 747: RVCORR = 4.0000 07440097 ! 748: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07450097 ! 749: 9031 CONTINUE 07460097 ! 750: IVTNUM = 903 07470097 ! 751: C 07480097 ! 752: C **** TEST 903 **** 07490097 ! 753: C 07500097 ! 754: IF (ICZERO) 39030, 9030, 39030 07510097 ! 755: 9030 CONTINUE 07520097 ! 756: RVON01 = 2.0 07530097 ! 757: RVON02 = 10.0 07540097 ! 758: RVCOMP = DIM (RVON01,RVON02) 07550097 ! 759: GO TO 49030 07560097 ! 760: 39030 IVDELE = IVDELE + 1 07570097 ! 761: WRITE (I02,80003) IVTNUM 07580097 ! 762: IF (ICZERO) 49030, 9041, 49030 07590097 ! 763: 49030 IF (RVCOMP) 29030,19030,29030 07600097 ! 764: 19030 IVPASS = IVPASS + 1 07610097 ! 765: WRITE (I02,80001) IVTNUM 07620097 ! 766: GO TO 9041 07630097 ! 767: 29030 IVFAIL = IVFAIL + 1 07640097 ! 768: RVCORR = 0.0000 07650097 ! 769: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07660097 ! 770: 9041 CONTINUE 07670097 ! 771: IVTNUM = 904 07680097 ! 772: C 07690097 ! 773: C **** TEST 904 **** 07700097 ! 774: C 07710097 ! 775: IF (ICZERO) 39040, 9040, 39040 07720097 ! 776: 9040 CONTINUE 07730097 ! 777: RVON01 = 1.65E+1 07740097 ! 778: RVON02 = -2.0 07750097 ! 779: RVCOMP = DIM (RVON01,RVON02) 07760097 ! 780: GO TO 49040 07770097 ! 781: 39040 IVDELE = IVDELE + 1 07780097 ! 782: WRITE (I02,80003) IVTNUM 07790097 ! 783: IF (ICZERO) 49040, 9051, 49040 07800097 ! 784: 49040 IF (RVCOMP - 18.495) 29040,19040,49041 07810097 ! 785: 49041 IF (RVCOMP - 18.505) 19040,19040,29040 07820097 ! 786: 19040 IVPASS = IVPASS + 1 07830097 ! 787: WRITE (I02,80001) IVTNUM 07840097 ! 788: GO TO 9051 07850097 ! 789: 29040 IVFAIL = IVFAIL + 1 07860097 ! 790: RVCORR = 18.500 07870097 ! 791: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07880097 ! 792: 9051 CONTINUE 07890097 ! 793: C 07900097 ! 794: C TESTS 905 AND 906 CONTAIN EXPRESSIONS CONTAINING MORE THAN ONE 07910097 ! 795: C INTRINSIC FUNCTION - ALL ARGUMENTS AND FUNCTIONS ARE REAL 07920097 ! 796: C 07930097 ! 797: IVTNUM = 905 07940097 ! 798: C 07950097 ! 799: C **** TEST 905 **** 07960097 ! 800: C 07970097 ! 801: IF (ICZERO) 39050, 9050, 39050 07980097 ! 802: 9050 CONTINUE 07990097 ! 803: RVON01 = 33.3 08000097 ! 804: RVON02 = -12.1 08010097 ! 805: RVCOMP = AINT (RVON01) + ABS (RVON02) 08020097 ! 806: GO TO 49050 08030097 ! 807: 39050 IVDELE = IVDELE + 1 08040097 ! 808: WRITE (I02,80003) IVTNUM 08050097 ! 809: IF (ICZERO) 49050, 9061, 49050 08060097 ! 810: 49050 IF (RVCOMP - 45.095) 29050,19050,49051 08070097 ! 811: 49051 IF (RVCOMP - 45.105) 19050,19050,29050 08080097 ! 812: 19050 IVPASS = IVPASS + 1 08090097 ! 813: WRITE (I02,80001) IVTNUM 08100097 ! 814: GO TO 9061 08110097 ! 815: 29050 IVFAIL = IVFAIL + 1 08120097 ! 816: RVCORR = 45.100 08130097 ! 817: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08140097 ! 818: 9061 CONTINUE 08150097 ! 819: IVTNUM = 906 08160097 ! 820: C 08170097 ! 821: C **** TEST 906 **** 08180097 ! 822: C 08190097 ! 823: IF (ICZERO) 39060, 9060, 39060 08200097 ! 824: 9060 CONTINUE 08210097 ! 825: RVON01 = 76.3 08220097 ! 826: RVON02 = 2.1E1 08230097 ! 827: RVON03 = 3E1 08240097 ! 828: RVCOMP = AMAX1(RVON01,RVON02,RVON03)-AMIN1(RVON01,RVON02,RVON03) 08250097 ! 829: GO TO 49060 08260097 ! 830: 39060 IVDELE = IVDELE + 1 08270097 ! 831: WRITE (I02,80003) IVTNUM 08280097 ! 832: IF (ICZERO) 49060, 9071, 49060 08290097 ! 833: 49060 IF (RVCOMP - 55.295) 29060,19060,49061 08300097 ! 834: 49061 IF (RVCOMP - 55.305) 19060,19060,29060 08310097 ! 835: 19060 IVPASS = IVPASS + 1 08320097 ! 836: WRITE (I02,80001) IVTNUM 08330097 ! 837: GO TO 9071 08340097 ! 838: 29060 IVFAIL = IVFAIL + 1 08350097 ! 839: RVCORR = 55.300 08360097 ! 840: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08370097 ! 841: 9071 CONTINUE 08380097 ! 842: C 08390097 ! 843: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08400097 ! 844: 99999 CONTINUE 08410097 ! 845: WRITE (I02,90002) 08420097 ! 846: WRITE (I02,90006) 08430097 ! 847: WRITE (I02,90002) 08440097 ! 848: WRITE (I02,90002) 08450097 ! 849: WRITE (I02,90007) 08460097 ! 850: WRITE (I02,90002) 08470097 ! 851: WRITE (I02,90008) IVFAIL 08480097 ! 852: WRITE (I02,90009) IVPASS 08490097 ! 853: WRITE (I02,90010) IVDELE 08500097 ! 854: C 08510097 ! 855: C 08520097 ! 856: C TERMINATE ROUTINE EXECUTION 08530097 ! 857: STOP 08540097 ! 858: C 08550097 ! 859: C FORMAT STATEMENTS FOR PAGE HEADERS 08560097 ! 860: 90000 FORMAT (1H1) 08570097 ! 861: 90002 FORMAT (1H ) 08580097 ! 862: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 08590097 ! 863: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 08600097 ! 864: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 08610097 ! 865: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 08620097 ! 866: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 08630097 ! 867: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 08640097 ! 868: C 08650097 ! 869: C FORMAT STATEMENTS FOR RUN SUMMARIES 08660097 ! 870: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 08670097 ! 871: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 08680097 ! 872: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 08690097 ! 873: C 08700097 ! 874: C FORMAT STATEMENTS FOR TEST RESULTS 08710097 ! 875: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 08720097 ! 876: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 08730097 ! 877: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 08740097 ! 878: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 08750097 ! 879: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 08760097 ! 880: C 08770097 ! 881: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM097) 08780097 ! 882: END 08790097
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.