|
|
1.1 ! root 1: C COMMENT SECTION 00010061 ! 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 00020061 ! 6: C FM061 00030061 ! 7: C 00040061 ! 8: C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050061 ! 9: C FORM 00060061 ! 10: C INTEGER VARIABLE = REAL CONSTANT 00070061 ! 11: C INTEGER VARIABLE = REAL VARIABLE 00080061 ! 12: C REAL VARIABLE = INTEGER VARIABLE 00090061 ! 13: C REAL VARIABLE = INTEGER CONSTANT 00100061 ! 14: C 00110061 ! 15: C THE CONSTANTS AND VARIABLES CONTAIN BOTH POSITIVE AND NEGATIVE 00120061 ! 16: C VALUES. 00130061 ! 17: C 00140061 ! 18: C A REAL DATUM IS A PROCESSOR APPROXIMATION TO THE VALUE OF A 00150061 ! 19: C REAL NUMBER. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES. 00160061 ! 20: C 00170061 ! 21: C A BASIC REAL CONSTANT IS WRITTEN AS AN INTEGER PART, A 00180061 ! 22: C DECIMAL POINT, AND A DECIMAL FRACTION PART IN THAT ORDER. BOTH 00190061 ! 23: C THE INTEGER PART AND THE DECIMAL PART ARE STRINGS OF DIGITS; 00200061 ! 24: C EITHER ONE OF THESE STRINGS MAY BE EMPTY BUT NOT BOTH. THE 00210061 ! 25: C CONSTANT IS AN APPROXIMATION TO THE DIGIT STRING INTERPRETED AS A 00220061 ! 26: C DECIMAL NUMERAL. 00230061 ! 27: C 00240061 ! 28: C A DECIMAL EXPONENT IS WRITTEN AS THE LETTER E, FOLLOWED BY AN 00250061 ! 29: C OPTIONALLY SIGNED INTEGER CONSTANT. 00260061 ! 30: C 00270061 ! 31: C A REAL CONSTANT IS INDICATED BY WRITING A BASIC REAL CONSTANT,00280061 ! 32: C A BASIC REAL CONSTANT FOLLOWED BY A DECIMAL EXPONENT, OR AN 00290061 ! 33: C INTEGER CONSTANT FOLLOWED BY A DECIMAL EXPONENT. 00300061 ! 34: C 00310061 ! 35: C REFERENCES 00320061 ! 36: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00330061 ! 37: C X3.9-1978 00340061 ! 38: C 00350061 ! 39: C SECTION 4.4, REAL TYPE 00360061 ! 40: C SECTION 4.4.1, REAL CONSTANT 00370061 ! 41: C SECTION 6.1, ARITHMETIC EXPRESSIONS 00380061 ! 42: C SECTION 6.6, EVALUATION OF EXPRESSIONS 00390061 ! 43: C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00400061 ! 44: C SECTION 11.4, ARITHMETIC IF STATEMENT 00410061 ! 45: C 00420061 ! 46: C ********************************************************** 00430061 ! 47: C 00440061 ! 48: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00450061 ! 49: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00460061 ! 50: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00470061 ! 51: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00480061 ! 52: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00490061 ! 53: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00500061 ! 54: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00510061 ! 55: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00520061 ! 56: C OF EXECUTING THESE TESTS. 00530061 ! 57: C 00540061 ! 58: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00550061 ! 59: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00560061 ! 60: C 00570061 ! 61: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00580061 ! 62: C 00590061 ! 63: C DEPARTMENT OF THE NAVY 00600061 ! 64: C FEDERAL COBOL COMPILER TESTING SERVICE 00610061 ! 65: C WASHINGTON, D.C. 20376 00620061 ! 66: C 00630061 ! 67: C ********************************************************** 00640061 ! 68: C 00650061 ! 69: C 00660061 ! 70: C 00670061 ! 71: C INITIALIZATION SECTION 00680061 ! 72: C 00690061 ! 73: C INITIALIZE CONSTANTS 00700061 ! 74: C ************** 00710061 ! 75: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00720061 ! 76: I01 = 5 00730061 ! 77: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00740061 ! 78: I02 = 6 00750061 ! 79: C SYSTEM ENVIRONMENT SECTION 00760061 ! 80: C 00770061 ! 81: I01 = 5 00780061 ! 82: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00790061 ! 83: C (UNIT NUMBER FOR CARD READER). 00800061 ! 84: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00810061 ! 85: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00820061 ! 86: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00830061 ! 87: C 00840061 ! 88: I02 = 6 00850061 ! 89: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00860061 ! 90: C (UNIT NUMBER FOR PRINTER). 00870061 ! 91: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00880061 ! 92: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00890061 ! 93: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00900061 ! 94: C 00910061 ! 95: IVPASS=0 00920061 ! 96: IVFAIL=0 00930061 ! 97: IVDELE=0 00940061 ! 98: ICZERO=0 00950061 ! 99: C 00960061 ! 100: C WRITE PAGE HEADERS 00970061 ! 101: WRITE (I02,90000) 00980061 ! 102: WRITE (I02,90001) 00990061 ! 103: WRITE (I02,90002) 01000061 ! 104: WRITE (I02, 90002) 01010061 ! 105: WRITE (I02,90003) 01020061 ! 106: WRITE (I02,90002) 01030061 ! 107: WRITE (I02,90004) 01040061 ! 108: WRITE (I02,90002) 01050061 ! 109: WRITE (I02,90011) 01060061 ! 110: WRITE (I02,90002) 01070061 ! 111: WRITE (I02,90002) 01080061 ! 112: WRITE (I02,90005) 01090061 ! 113: WRITE (I02,90006) 01100061 ! 114: WRITE (I02,90002) 01110061 ! 115: C 01120061 ! 116: C TEST SECTION 01130061 ! 117: C 01140061 ! 118: C TEST 32 THROUGH TEST 42 CONTAIN ARITHMETIC ASSIGNMENT 01150061 ! 119: C STATEMENTS OF THE FORM 01160061 ! 120: C 01170061 ! 121: C INTEGER VARIABLE = REAL VARIABLE 01180061 ! 122: C 01190061 ! 123: IVTNUM = 32 01200061 ! 124: C 01210061 ! 125: C **** TEST 32 **** 01220061 ! 126: C 01230061 ! 127: IF (ICZERO) 30320, 320, 30320 01240061 ! 128: 320 CONTINUE 01250061 ! 129: RVON01 = 44.5 01260061 ! 130: IVCOMP = RVON01 01270061 ! 131: GO TO 40320 01280061 ! 132: 30320 IVDELE = IVDELE + 1 01290061 ! 133: WRITE (I02,80003) IVTNUM 01300061 ! 134: IF (ICZERO) 40320, 331, 40320 01310061 ! 135: 40320 IF (IVCOMP - 44) 20320,10320,20320 01320061 ! 136: 10320 IVPASS = IVPASS + 1 01330061 ! 137: WRITE (I02,80001) IVTNUM 01340061 ! 138: GO TO 331 01350061 ! 139: 20320 IVFAIL = IVFAIL + 1 01360061 ! 140: IVCORR = 44 01370061 ! 141: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01380061 ! 142: 331 CONTINUE 01390061 ! 143: IVTNUM = 33 01400061 ! 144: C 01410061 ! 145: C **** TEST 33 **** 01420061 ! 146: C 01430061 ! 147: IF (ICZERO) 30330, 330, 30330 01440061 ! 148: 330 CONTINUE 01450061 ! 149: RVON01 = -2.0005 01460061 ! 150: IVCOMP = RVON01 01470061 ! 151: GO TO 40330 01480061 ! 152: 30330 IVDELE = IVDELE + 1 01490061 ! 153: WRITE (I02,80003) IVTNUM 01500061 ! 154: IF (ICZERO) 40330, 341, 40330 01510061 ! 155: 40330 IF (IVCOMP + 2) 20330,10330,20330 01520061 ! 156: 10330 IVPASS = IVPASS + 1 01530061 ! 157: WRITE (I02,80001) IVTNUM 01540061 ! 158: GO TO 341 01550061 ! 159: 20330 IVFAIL = IVFAIL + 1 01560061 ! 160: IVCORR = -2 01570061 ! 161: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01580061 ! 162: 341 CONTINUE 01590061 ! 163: IVTNUM = 34 01600061 ! 164: C 01610061 ! 165: C **** TEST 34 **** 01620061 ! 166: C 01630061 ! 167: IF (ICZERO) 30340, 340, 30340 01640061 ! 168: 340 CONTINUE 01650061 ! 169: RVON01 = .32767 01660061 ! 170: IVCOMP = RVON01 01670061 ! 171: GO TO 40340 01680061 ! 172: 30340 IVDELE = IVDELE + 1 01690061 ! 173: WRITE (I02,80003) IVTNUM 01700061 ! 174: IF (ICZERO) 40340, 351, 40340 01710061 ! 175: 40340 IF (IVCOMP) 20340,10340,20340 01720061 ! 176: 10340 IVPASS = IVPASS + 1 01730061 ! 177: WRITE (I02,80001) IVTNUM 01740061 ! 178: GO TO 351 01750061 ! 179: 20340 IVFAIL = IVFAIL + 1 01760061 ! 180: IVCORR = 0 01770061 ! 181: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01780061 ! 182: 351 CONTINUE 01790061 ! 183: IVTNUM = 35 01800061 ! 184: C 01810061 ! 185: C **** TEST 35 **** 01820061 ! 186: C 01830061 ! 187: IF (ICZERO) 30350, 350, 30350 01840061 ! 188: 350 CONTINUE 01850061 ! 189: RVON01 = 1.999 01860061 ! 190: IVCOMP = RVON01 01870061 ! 191: GO TO 40350 01880061 ! 192: 30350 IVDELE = IVDELE + 1 01890061 ! 193: WRITE (I02,80003) IVTNUM 01900061 ! 194: IF (ICZERO) 40350, 361, 40350 01910061 ! 195: 40350 IF (IVCOMP - 1) 20350,10350,20350 01920061 ! 196: 10350 IVPASS = IVPASS + 1 01930061 ! 197: WRITE (I02,80001) IVTNUM 01940061 ! 198: GO TO 361 01950061 ! 199: 20350 IVFAIL = IVFAIL + 1 01960061 ! 200: IVCORR = 1 01970061 ! 201: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01980061 ! 202: 361 CONTINUE 01990061 ! 203: IVTNUM = 36 02000061 ! 204: C 02010061 ! 205: C **** TEST 36 **** 02020061 ! 206: C 02030061 ! 207: IF (ICZERO) 30360, 360, 30360 02040061 ! 208: 360 CONTINUE 02050061 ! 209: RVON01 = .25E+1 02060061 ! 210: IVCOMP = RVON01 02070061 ! 211: GO TO 40360 02080061 ! 212: 30360 IVDELE = IVDELE + 1 02090061 ! 213: WRITE (I02,80003) IVTNUM 02100061 ! 214: IF (ICZERO) 40360, 371, 40360 02110061 ! 215: 40360 IF (IVCOMP - 2) 20360,10360,20360 02120061 ! 216: 10360 IVPASS = IVPASS + 1 02130061 ! 217: WRITE (I02,80001) IVTNUM 02140061 ! 218: GO TO 371 02150061 ! 219: 20360 IVFAIL = IVFAIL + 1 02160061 ! 220: IVCORR = 2 02170061 ! 221: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02180061 ! 222: 371 CONTINUE 02190061 ! 223: IVTNUM = 37 02200061 ! 224: C 02210061 ! 225: C **** TEST 37 **** 02220061 ! 226: C 02230061 ! 227: IF (ICZERO) 30370, 370, 30370 02240061 ! 228: 370 CONTINUE 02250061 ! 229: RVON01 = 445.0E-01 02260061 ! 230: IVCOMP = RVON01 02270061 ! 231: GO TO 40370 02280061 ! 232: 30370 IVDELE = IVDELE + 1 02290061 ! 233: WRITE (I02,80003) IVTNUM 02300061 ! 234: IF (ICZERO) 40370, 381, 40370 02310061 ! 235: 40370 IF (IVCOMP - 44) 20370,10370,20370 02320061 ! 236: 10370 IVPASS = IVPASS + 1 02330061 ! 237: WRITE (I02,80001) IVTNUM 02340061 ! 238: GO TO 381 02350061 ! 239: 20370 IVFAIL = IVFAIL + 1 02360061 ! 240: IVCORR = 44 02370061 ! 241: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02380061 ! 242: 381 CONTINUE 02390061 ! 243: IVTNUM = 38 02400061 ! 244: C 02410061 ! 245: C **** TEST 38 **** 02420061 ! 246: C 02430061 ! 247: IF (ICZERO) 30380, 380, 30380 02440061 ! 248: 380 CONTINUE 02450061 ! 249: RVON01 = -651.1E-0 02460061 ! 250: IVCOMP = RVON01 02470061 ! 251: GO TO 40380 02480061 ! 252: 30380 IVDELE = IVDELE + 1 02490061 ! 253: WRITE (I02,80003) IVTNUM 02500061 ! 254: IF (ICZERO) 40380, 391, 40380 02510061 ! 255: 40380 IF (IVCOMP + 651) 20380,10380,20380 02520061 ! 256: 10380 IVPASS = IVPASS + 1 02530061 ! 257: WRITE (I02,80001) IVTNUM 02540061 ! 258: GO TO 391 02550061 ! 259: 20380 IVFAIL = IVFAIL + 1 02560061 ! 260: IVCORR = -651 02570061 ! 261: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02580061 ! 262: 391 CONTINUE 02590061 ! 263: IVTNUM = 39 02600061 ! 264: C 02610061 ! 265: C **** TEST 39 **** 02620061 ! 266: C 02630061 ! 267: IF (ICZERO) 30390, 390, 30390 02640061 ! 268: 390 CONTINUE 02650061 ! 269: RVON01 = .3266E4 02660061 ! 270: IVCOMP = RVON01 02670061 ! 271: GO TO 40390 02680061 ! 272: 30390 IVDELE = IVDELE + 1 02690061 ! 273: WRITE (I02,80003) IVTNUM 02700061 ! 274: IF (ICZERO) 40390, 401, 40390 02710061 ! 275: 40390 IF (IVCOMP - 3266) 20390,10390,20390 02720061 ! 276: 10390 IVPASS = IVPASS + 1 02730061 ! 277: WRITE (I02,80001) IVTNUM 02740061 ! 278: GO TO 401 02750061 ! 279: 20390 IVFAIL = IVFAIL + 1 02760061 ! 280: IVCORR = 3266 02770061 ! 281: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02780061 ! 282: 401 CONTINUE 02790061 ! 283: IVTNUM = 40 02800061 ! 284: C 02810061 ! 285: C **** TEST 40 **** 02820061 ! 286: C 02830061 ! 287: IF (ICZERO) 30400, 400, 30400 02840061 ! 288: 400 CONTINUE 02850061 ! 289: RVON01 = 35.43E-01 02860061 ! 290: IVCOMP = RVON01 02870061 ! 291: GO TO 40400 02880061 ! 292: 30400 IVDELE = IVDELE + 1 02890061 ! 293: WRITE (I02,80003) IVTNUM 02900061 ! 294: IF (ICZERO) 40400, 411, 40400 02910061 ! 295: 40400 IF (IVCOMP - 3) 20400,10400,20400 02920061 ! 296: 10400 IVPASS = IVPASS + 1 02930061 ! 297: WRITE (I02,80001) IVTNUM 02940061 ! 298: GO TO 411 02950061 ! 299: 20400 IVFAIL = IVFAIL + 1 02960061 ! 300: IVCORR = 3 02970061 ! 301: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02980061 ! 302: 411 CONTINUE 02990061 ! 303: IVTNUM = 41 03000061 ! 304: C 03010061 ! 305: C **** TEST 41 **** 03020061 ! 306: C 03030061 ! 307: IF (ICZERO) 30410, 410, 30410 03040061 ! 308: 410 CONTINUE 03050061 ! 309: RVON01 = -7.001E2 03060061 ! 310: IVCOMP = RVON01 03070061 ! 311: GO TO 40410 03080061 ! 312: 30410 IVDELE = IVDELE + 1 03090061 ! 313: WRITE (I02,80003) IVTNUM 03100061 ! 314: IF (ICZERO) 40410, 421, 40410 03110061 ! 315: 40410 IF (IVCOMP + 700) 20410,10410,20410 03120061 ! 316: 10410 IVPASS = IVPASS + 1 03130061 ! 317: WRITE (I02,80001) IVTNUM 03140061 ! 318: GO TO 421 03150061 ! 319: 20410 IVFAIL = IVFAIL + 1 03160061 ! 320: IVCORR = -700 03170061 ! 321: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03180061 ! 322: 421 CONTINUE 03190061 ! 323: IVTNUM = 42 03200061 ! 324: C 03210061 ! 325: C **** TEST 42 **** 03220061 ! 326: C 03230061 ! 327: IF (ICZERO) 30420, 420, 30420 03240061 ! 328: 420 CONTINUE 03250061 ! 329: RVON01 = 4.45E-02 03260061 ! 330: IVCOMP = RVON01 03270061 ! 331: GO TO 40420 03280061 ! 332: 30420 IVDELE = IVDELE + 1 03290061 ! 333: WRITE (I02,80003) IVTNUM 03300061 ! 334: IF (ICZERO) 40420, 431, 40420 03310061 ! 335: 40420 IF (IVCOMP) 20420,10420,20420 03320061 ! 336: 10420 IVPASS = IVPASS + 1 03330061 ! 337: WRITE (I02,80001) IVTNUM 03340061 ! 338: GO TO 431 03350061 ! 339: 20420 IVFAIL = IVFAIL + 1 03360061 ! 340: IVCORR = 0 03370061 ! 341: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03380061 ! 342: C TEST 43 THROUGH TEST 48 CONTAIN ARITHMETIC ASSIGNMENT 03390061 ! 343: C STATEMENTS OF THE FORM 03400061 ! 344: C 03410061 ! 345: C REAL VARIABLE = INTEGER VARIABLE 03420061 ! 346: C 03430061 ! 347: 431 CONTINUE 03440061 ! 348: IVTNUM = 43 03450061 ! 349: C 03460061 ! 350: C **** TEST 43 **** 03470061 ! 351: C 03480061 ! 352: IF (ICZERO) 30430, 430, 30430 03490061 ! 353: 430 CONTINUE 03500061 ! 354: IVON01 = 2 03510061 ! 355: RVCOMP = IVON01 03520061 ! 356: GO TO 40430 03530061 ! 357: 30430 IVDELE = IVDELE + 1 03540061 ! 358: WRITE (I02,80003) IVTNUM 03550061 ! 359: IF (ICZERO) 40430, 441, 40430 03560061 ! 360: 40430 IF (RVCOMP - 1.9995) 20430,10430,40431 03570061 ! 361: 40431 IF (RVCOMP - 2.0005) 10430,10430,20430 03580061 ! 362: 10430 IVPASS = IVPASS + 1 03590061 ! 363: WRITE (I02,80001) IVTNUM 03600061 ! 364: GO TO 441 03610061 ! 365: 20430 IVFAIL = IVFAIL + 1 03620061 ! 366: RVCORR = 2.0000 03630061 ! 367: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03640061 ! 368: 441 CONTINUE 03650061 ! 369: IVTNUM = 44 03660061 ! 370: C 03670061 ! 371: C **** TEST 44 **** 03680061 ! 372: C 03690061 ! 373: IF (ICZERO) 30440, 440, 30440 03700061 ! 374: 440 CONTINUE 03710061 ! 375: IVON01 = 25 03720061 ! 376: RVCOMP = IVON01 03730061 ! 377: GO TO 40440 03740061 ! 378: 30440 IVDELE = IVDELE + 1 03750061 ! 379: WRITE (I02,80003) IVTNUM 03760061 ! 380: IF (ICZERO) 40440, 451, 40440 03770061 ! 381: 40440 IF (RVCOMP - 24.995) 20440,10440,40441 03780061 ! 382: 40441 IF (RVCOMP - 25.005) 10440,10440,20440 03790061 ! 383: 10440 IVPASS = IVPASS + 1 03800061 ! 384: WRITE (I02,80001) IVTNUM 03810061 ! 385: GO TO 451 03820061 ! 386: 20440 IVFAIL = IVFAIL + 1 03830061 ! 387: RVCORR = 25.000 03840061 ! 388: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03850061 ! 389: 451 CONTINUE 03860061 ! 390: IVTNUM = 45 03870061 ! 391: C 03880061 ! 392: C **** TEST 45 **** 03890061 ! 393: C 03900061 ! 394: IF (ICZERO) 30450, 450, 30450 03910061 ! 395: 450 CONTINUE 03920061 ! 396: IVON01 = 357 03930061 ! 397: RVCOMP = IVON01 03940061 ! 398: GO TO 40450 03950061 ! 399: 30450 IVDELE = IVDELE + 1 03960061 ! 400: WRITE (I02,80003) IVTNUM 03970061 ! 401: IF (ICZERO) 40450, 461, 40450 03980061 ! 402: 40450 IF (RVCOMP - 356.95) 20450,10450,40451 03990061 ! 403: 40451 IF (RVCOMP - 357.05) 10450,10450,20450 04000061 ! 404: 10450 IVPASS = IVPASS + 1 04010061 ! 405: WRITE (I02,80001) IVTNUM 04020061 ! 406: GO TO 461 04030061 ! 407: 20450 IVFAIL = IVFAIL + 1 04040061 ! 408: RVCORR = 357.00 04050061 ! 409: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04060061 ! 410: 461 CONTINUE 04070061 ! 411: IVTNUM = 46 04080061 ! 412: C 04090061 ! 413: C **** TEST 46 **** 04100061 ! 414: C 04110061 ! 415: IF (ICZERO) 30460, 460, 30460 04120061 ! 416: 460 CONTINUE 04130061 ! 417: IVON01 = 4968 04140061 ! 418: RVCOMP = IVON01 04150061 ! 419: GO TO 40460 04160061 ! 420: 30460 IVDELE = IVDELE + 1 04170061 ! 421: WRITE (I02,80003) IVTNUM 04180061 ! 422: IF (ICZERO) 40460, 471, 40460 04190061 ! 423: 40460 IF (RVCOMP - 4967.5) 20460,10460,40461 04200061 ! 424: 40461 IF (RVCOMP - 4968.5) 10460,10460,20460 04210061 ! 425: 10460 IVPASS = IVPASS + 1 04220061 ! 426: WRITE (I02,80001) IVTNUM 04230061 ! 427: GO TO 471 04240061 ! 428: 20460 IVFAIL = IVFAIL + 1 04250061 ! 429: RVCORR = 4968.0 04260061 ! 430: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04270061 ! 431: 471 CONTINUE 04280061 ! 432: IVTNUM = 47 04290061 ! 433: C 04300061 ! 434: C **** TEST 47 **** 04310061 ! 435: C 04320061 ! 436: IF (ICZERO) 30470, 470, 30470 04330061 ! 437: 470 CONTINUE 04340061 ! 438: IVON01 = 32767 04350061 ! 439: RVCOMP = IVON01 04360061 ! 440: GO TO 40470 04370061 ! 441: 30470 IVDELE = IVDELE + 1 04380061 ! 442: WRITE (I02,80003) IVTNUM 04390061 ! 443: IF (ICZERO) 40470, 481, 40470 04400061 ! 444: 40470 IF (RVCOMP - 32762.) 20470,10470,40471 04410061 ! 445: 40471 IF (RVCOMP - 32772.) 10470,10470,20470 04420061 ! 446: 10470 IVPASS = IVPASS + 1 04430061 ! 447: WRITE (I02,80001) IVTNUM 04440061 ! 448: GO TO 481 04450061 ! 449: 20470 IVFAIL = IVFAIL + 1 04460061 ! 450: RVCORR = 32767. 04470061 ! 451: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04480061 ! 452: 481 CONTINUE 04490061 ! 453: IVTNUM = 48 04500061 ! 454: C 04510061 ! 455: C **** TEST 48 **** 04520061 ! 456: C 04530061 ! 457: IF (ICZERO) 30480, 480, 30480 04540061 ! 458: 480 CONTINUE 04550061 ! 459: IVON01 = -2 04560061 ! 460: RVCOMP = IVON01 04570061 ! 461: GO TO 40480 04580061 ! 462: 30480 IVDELE = IVDELE + 1 04590061 ! 463: WRITE (I02,80003) IVTNUM 04600061 ! 464: IF (ICZERO) 40480, 491, 40480 04610061 ! 465: 40480 IF (RVCOMP + 2.0005) 20480,10480,40481 04620061 ! 466: 40481 IF (RVCOMP + 1.9995) 10480,10480,20450 04630061 ! 467: 10480 IVPASS = IVPASS + 1 04640061 ! 468: WRITE (I02,80001) IVTNUM 04650061 ! 469: GO TO 491 04660061 ! 470: 20480 IVFAIL = IVFAIL + 1 04670061 ! 471: RVCORR = -2.0000 04680061 ! 472: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04690061 ! 473: C 04700061 ! 474: C TEST 49 THROUGH TEST 51 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS 04710061 ! 475: C OF THE FORM 04720061 ! 476: C INTEGER VARIABLE = REAL CONSTANT 04730061 ! 477: C WHERE CONSTANT IS BASIC REAL CONSTANT 04740061 ! 478: C 04750061 ! 479: 491 CONTINUE 04760061 ! 480: IVTNUM = 49 04770061 ! 481: C 04780061 ! 482: C **** TEST 49 **** 04790061 ! 483: C 04800061 ! 484: IF (ICZERO) 30490, 490, 30490 04810061 ! 485: 490 CONTINUE 04820061 ! 486: IVCOMP = 44.5 04830061 ! 487: GO TO 40490 04840061 ! 488: 30490 IVDELE = IVDELE + 1 04850061 ! 489: WRITE (I02,80003) IVTNUM 04860061 ! 490: IF (ICZERO) 40490, 501, 40490 04870061 ! 491: 40490 IF (IVCOMP - 44) 20490,10490,20490 04880061 ! 492: 10490 IVPASS = IVPASS + 1 04890061 ! 493: WRITE (I02,80001) IVTNUM 04900061 ! 494: GO TO 501 04910061 ! 495: 20490 IVFAIL = IVFAIL + 1 04920061 ! 496: IVCORR = 44 04930061 ! 497: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04940061 ! 498: 501 CONTINUE 04950061 ! 499: IVTNUM = 50 04960061 ! 500: C 04970061 ! 501: C **** TEST 50 **** 04980061 ! 502: C 04990061 ! 503: IF (ICZERO) 30500, 500, 30500 05000061 ! 504: 500 CONTINUE 05010061 ! 505: IVCOMP = 6500.1 05020061 ! 506: GO TO 40500 05030061 ! 507: 30500 IVDELE = IVDELE + 1 05040061 ! 508: WRITE (I02,80003) IVTNUM 05050061 ! 509: IF (ICZERO) 40500, 511, 40500 05060061 ! 510: 40500 IF (IVCOMP - 6500) 20500,10500,20500 05070061 ! 511: 10500 IVPASS = IVPASS + 1 05080061 ! 512: WRITE (I02,80001) IVTNUM 05090061 ! 513: GO TO 511 05100061 ! 514: 20500 IVFAIL = IVFAIL + 1 05110061 ! 515: IVCORR = 6500 05120061 ! 516: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05130061 ! 517: 511 CONTINUE 05140061 ! 518: IVTNUM = 51 05150061 ! 519: C 05160061 ! 520: C **** TEST 51 **** 05170061 ! 521: C 05180061 ! 522: IF (ICZERO) 30510, 510, 30510 05190061 ! 523: 510 CONTINUE 05200061 ! 524: IVCOMP = -.33333 05210061 ! 525: GO TO 40510 05220061 ! 526: 30510 IVDELE = IVDELE + 1 05230061 ! 527: WRITE (I02,80003) IVTNUM 05240061 ! 528: IF (ICZERO) 40510, 521, 40510 05250061 ! 529: 40510 IF (IVCOMP) 20510,10510,20510 05260061 ! 530: 10510 IVPASS = IVPASS + 1 05270061 ! 531: WRITE (I02,80001) IVTNUM 05280061 ! 532: GO TO 521 05290061 ! 533: 20510 IVFAIL = IVFAIL + 1 05300061 ! 534: IVCORR = 0 05310061 ! 535: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05320061 ! 536: C 05330061 ! 537: C TEST 52 THROUGH TEST 55 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS 05340061 ! 538: C OF THE FORM 05350061 ! 539: C INTEGER VARIABLE = REAL CONSTANT 05360061 ! 540: C 05370061 ! 541: C WHERE CONSTANT IS BASIC REAL CONSTANT FOLLOWED BY DECIMAL EXPONENT05380061 ! 542: C 05390061 ! 543: 521 CONTINUE 05400061 ! 544: IVTNUM = 52 05410061 ! 545: C 05420061 ! 546: C **** TEST 52 **** 05430061 ! 547: C 05440061 ! 548: IF (ICZERO) 30520, 520, 30520 05450061 ! 549: 520 CONTINUE 05460061 ! 550: IVCOMP = .21E+1 05470061 ! 551: GO TO 40520 05480061 ! 552: 30520 IVDELE = IVDELE + 1 05490061 ! 553: WRITE (I02,80003) IVTNUM 05500061 ! 554: IF (ICZERO) 40520, 531, 40520 05510061 ! 555: 40520 IF (IVCOMP - 2) 20520,10520,20520 05520061 ! 556: 10520 IVPASS = IVPASS + 1 05530061 ! 557: WRITE (I02,80001) IVTNUM 05540061 ! 558: GO TO 531 05550061 ! 559: 20520 IVFAIL = IVFAIL + 1 05560061 ! 560: IVCORR = 2 05570061 ! 561: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05580061 ! 562: 531 CONTINUE 05590061 ! 563: IVTNUM = 53 05600061 ! 564: C 05610061 ! 565: C **** TEST 53 **** 05620061 ! 566: C 05630061 ! 567: IF (ICZERO) 30530, 530, 30530 05640061 ! 568: 530 CONTINUE 05650061 ! 569: IVCOMP = 445.0E-01 05660061 ! 570: GO TO 40530 05670061 ! 571: 30530 IVDELE = IVDELE + 1 05680061 ! 572: WRITE (I02,80003) IVTNUM 05690061 ! 573: IF (ICZERO) 40530, 541, 40530 05700061 ! 574: 40530 IF (IVCOMP - 44) 20530,10530,20530 05710061 ! 575: 10530 IVPASS = IVPASS + 1 05720061 ! 576: WRITE (I02,80001) IVTNUM 05730061 ! 577: GO TO 541 05740061 ! 578: 20530 IVFAIL = IVFAIL + 1 05750061 ! 579: IVCORR = 44 05760061 ! 580: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05770061 ! 581: 541 CONTINUE 05780061 ! 582: IVTNUM = 54 05790061 ! 583: C 05800061 ! 584: C **** TEST 54 **** 05810061 ! 585: C 05820061 ! 586: IF (ICZERO) 30540, 540, 30540 05830061 ! 587: 540 CONTINUE 05840061 ! 588: IVCOMP = 4.450E1 05850061 ! 589: GO TO 40540 05860061 ! 590: 30540 IVDELE = IVDELE + 1 05870061 ! 591: WRITE (I02,80003) IVTNUM 05880061 ! 592: IF (ICZERO) 40540, 551, 40540 05890061 ! 593: 40540 IF (IVCOMP - 44) 20540,10540,20540 05900061 ! 594: 10540 IVPASS = IVPASS + 1 05910061 ! 595: WRITE (I02,80001) IVTNUM 05920061 ! 596: GO TO 551 05930061 ! 597: 20540 IVFAIL = IVFAIL + 1 05940061 ! 598: IVCORR = 44 05950061 ! 599: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05960061 ! 600: 551 CONTINUE 05970061 ! 601: IVTNUM = 55 05980061 ! 602: C 05990061 ! 603: C **** TEST 55 **** 06000061 ! 604: C 06010061 ! 605: IF (ICZERO) 30550, 550, 30550 06020061 ! 606: 550 CONTINUE 06030061 ! 607: IVCOMP = -4.45E0 06040061 ! 608: GO TO 40550 06050061 ! 609: 30550 IVDELE = IVDELE + 1 06060061 ! 610: WRITE (I02,80003) IVTNUM 06070061 ! 611: IF (ICZERO) 40550, 561, 40550 06080061 ! 612: 40550 IF (IVCOMP + 4) 20550,10550,20550 06090061 ! 613: 10550 IVPASS = IVPASS + 1 06100061 ! 614: WRITE (I02,80001) IVTNUM 06110061 ! 615: GO TO 561 06120061 ! 616: 20550 IVFAIL = IVFAIL + 1 06130061 ! 617: IVCORR = -4 06140061 ! 618: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06150061 ! 619: C 06160061 ! 620: C TEST 56 AND 57 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS OF THE 06170061 ! 621: C FORM INTEGER VARIABLE = REAL CONSTANT 06180061 ! 622: C WHERE CONSTANT IS INTEGER CONSTANT FOLLOWED BY DECIMAL EXPONENT 06190061 ! 623: C 06200061 ! 624: 561 CONTINUE 06210061 ! 625: IVTNUM = 56 06220061 ! 626: C 06230061 ! 627: C **** TEST 56 **** 06240061 ! 628: C 06250061 ! 629: IF (ICZERO) 30560, 560, 30560 06260061 ! 630: 560 CONTINUE 06270061 ! 631: IVCOMP = 445E-02 06280061 ! 632: GO TO 40560 06290061 ! 633: 30560 IVDELE = IVDELE + 1 06300061 ! 634: WRITE (I02,80003) IVTNUM 06310061 ! 635: IF (ICZERO) 40560, 571, 40560 06320061 ! 636: 40560 IF (IVCOMP - 4) 20560,10560,20560 06330061 ! 637: 10560 IVPASS = IVPASS + 1 06340061 ! 638: WRITE (I02,80001) IVTNUM 06350061 ! 639: GO TO 571 06360061 ! 640: 20560 IVFAIL = IVFAIL + 1 06370061 ! 641: IVCORR = 4 06380061 ! 642: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06390061 ! 643: 571 CONTINUE 06400061 ! 644: IVTNUM = 57 06410061 ! 645: C 06420061 ! 646: C **** TEST 57 **** 06430061 ! 647: C 06440061 ! 648: IF (ICZERO) 30570, 570, 30570 06450061 ! 649: 570 CONTINUE 06460061 ! 650: IVCOMP = -701E-1 06470061 ! 651: GO TO 40570 06480061 ! 652: 30570 IVDELE = IVDELE + 1 06490061 ! 653: WRITE (I02,80003) IVTNUM 06500061 ! 654: IF (ICZERO) 40570, 581, 40570 06510061 ! 655: 40570 IF (IVCOMP + 70) 20570,10570,20570 06520061 ! 656: 10570 IVPASS = IVPASS + 1 06530061 ! 657: WRITE (I02,80001) IVTNUM 06540061 ! 658: GO TO 581 06550061 ! 659: 20570 IVFAIL = IVFAIL + 1 06560061 ! 660: IVCORR = -70 06570061 ! 661: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06580061 ! 662: C 06590061 ! 663: C TEST 58 THROUGH TEST 62 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS 06600061 ! 664: C OF THE FORM REAL VARIABLE = INTEGER CONSTANT 06610061 ! 665: C 06620061 ! 666: 581 CONTINUE 06630061 ! 667: IVTNUM = 58 06640061 ! 668: C 06650061 ! 669: C **** TEST 58 **** 06660061 ! 670: C 06670061 ! 671: IF (ICZERO) 30580, 580, 30580 06680061 ! 672: 580 CONTINUE 06690061 ! 673: RVCOMP = 23 06700061 ! 674: GO TO 40580 06710061 ! 675: 30580 IVDELE = IVDELE + 1 06720061 ! 676: WRITE (I02,80003) IVTNUM 06730061 ! 677: IF (ICZERO) 40580, 591, 40580 06740061 ! 678: 40580 IF (RVCOMP - 22.995) 20580,10580,40581 06750061 ! 679: 40581 IF (RVCOMP - 23.005) 10580,10580,20580 06760061 ! 680: 10580 IVPASS = IVPASS + 1 06770061 ! 681: WRITE (I02,80001) IVTNUM 06780061 ! 682: GO TO 591 06790061 ! 683: 20580 IVFAIL = IVFAIL + 1 06800061 ! 684: RVCORR = 23.000 06810061 ! 685: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06820061 ! 686: 591 CONTINUE 06830061 ! 687: IVTNUM = 59 06840061 ! 688: C 06850061 ! 689: C **** TEST 59 **** 06860061 ! 690: C 06870061 ! 691: IF (ICZERO) 30590, 590, 30590 06880061 ! 692: 590 CONTINUE 06890061 ! 693: RVCOMP = 32645 06900061 ! 694: GO TO 40590 06910061 ! 695: 30590 IVDELE = IVDELE + 1 06920061 ! 696: WRITE (I02,80003) IVTNUM 06930061 ! 697: IF (ICZERO) 40590, 601, 40590 06940061 ! 698: 40590 IF (RVCOMP - 32640.) 20590,10590,40591 06950061 ! 699: 40591 IF (RVCOMP - 32650.) 10590,10590,20590 06960061 ! 700: 10590 IVPASS = IVPASS + 1 06970061 ! 701: WRITE (I02,80001) IVTNUM 06980061 ! 702: GO TO 601 06990061 ! 703: 20590 IVFAIL = IVFAIL + 1 07000061 ! 704: RVCORR = 32645. 07010061 ! 705: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07020061 ! 706: 601 CONTINUE 07030061 ! 707: IVTNUM = 60 07040061 ! 708: C 07050061 ! 709: C **** TEST 60 **** 07060061 ! 710: C 07070061 ! 711: IF (ICZERO) 30600, 600, 30600 07080061 ! 712: 600 CONTINUE 07090061 ! 713: RVCOMP = 0 07100061 ! 714: GO TO 40600 07110061 ! 715: 30600 IVDELE = IVDELE + 1 07120061 ! 716: WRITE (I02,80003) IVTNUM 07130061 ! 717: IF (ICZERO) 40600, 611, 40600 07140061 ! 718: 40600 IF (RVCOMP) 20600,10600,20600 07150061 ! 719: 10600 IVPASS = IVPASS + 1 07160061 ! 720: WRITE (I02,80001) IVTNUM 07170061 ! 721: GO TO 611 07180061 ! 722: 20600 IVFAIL = IVFAIL + 1 07190061 ! 723: RVCORR = 00000. 07200061 ! 724: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07210061 ! 725: 611 CONTINUE 07220061 ! 726: IVTNUM = 61 07230061 ! 727: C 07240061 ! 728: C **** TEST 61 **** 07250061 ! 729: C 07260061 ! 730: IF (ICZERO) 30610, 610, 30610 07270061 ! 731: 610 CONTINUE 07280061 ! 732: RVCOMP = -15 07290061 ! 733: GO TO 40610 07300061 ! 734: 30610 IVDELE = IVDELE + 1 07310061 ! 735: WRITE (I02,80003) IVTNUM 07320061 ! 736: IF (ICZERO) 40610, 621, 40610 07330061 ! 737: 40610 IF (RVCOMP -14.995) 40611,10610,20610 07340061 ! 738: 40611 IF (RVCOMP + 15.005) 20610,10610,10610 07350061 ! 739: 10610 IVPASS = IVPASS + 1 07360061 ! 740: WRITE (I02,80001) IVTNUM 07370061 ! 741: GO TO 621 07380061 ! 742: 20610 IVFAIL = IVFAIL + 1 07390061 ! 743: RVCORR = -15.000 07400061 ! 744: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07410061 ! 745: 621 CONTINUE 07420061 ! 746: C 07430061 ! 747: C **** END OF TESTS **** 07440061 ! 748: C 07450061 ! 749: C 07460061 ! 750: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07470061 ! 751: 99999 CONTINUE 07480061 ! 752: WRITE (I02,90002) 07490061 ! 753: WRITE (I02,90006) 07500061 ! 754: WRITE (I02,90002) 07510061 ! 755: WRITE (I02,90002) 07520061 ! 756: WRITE (I02,90007) 07530061 ! 757: WRITE (I02,90002) 07540061 ! 758: WRITE (I02,90008) IVFAIL 07550061 ! 759: WRITE (I02,90009) IVPASS 07560061 ! 760: WRITE (I02,90010) IVDELE 07570061 ! 761: C 07580061 ! 762: C 07590061 ! 763: C TERMINATE ROUTINE EXECUTION 07600061 ! 764: STOP 07610061 ! 765: C 07620061 ! 766: C FORMAT STATEMENTS FOR PAGE HEADERS 07630061 ! 767: 90000 FORMAT (1H1) 07640061 ! 768: 90002 FORMAT (1H ) 07650061 ! 769: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 07660061 ! 770: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 07670061 ! 771: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 07680061 ! 772: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 07690061 ! 773: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 07700061 ! 774: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 07710061 ! 775: C 07720061 ! 776: C FORMAT STATEMENTS FOR RUN SUMMARIES 07730061 ! 777: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 07740061 ! 778: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 07750061 ! 779: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 07760061 ! 780: C 07770061 ! 781: C FORMAT STATEMENTS FOR TEST RESULTS 07780061 ! 782: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 07790061 ! 783: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 07800061 ! 784: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 07810061 ! 785: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 07820061 ! 786: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 07830061 ! 787: C 07840061 ! 788: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM061) 07850061 ! 789: END 07860061
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.