![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM020.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests|
Return to FM020.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: C 00010020 ! 2: C DATE***82/08/02*18.33.46 ! 3: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 4: C AUDIT FCVS78 V2.0 ! 5: C COMMENT SECTION. 00020020 ! 6: C 00030020 ! 7: C FM020 00040020 ! 8: C 00050020 ! 9: C THIS ROUTINE TESTS THE FORTRAN IN-LINE STATEMENT FUNCTION 00060020 ! 10: C OF TYPE LOGICAL AND INTEGER. INTEGER CONSTANTS, LOGICAL CONSTANTS00070020 ! 11: C INTEGER VARIABLES, LOGICAL VARIABLES, INTEGER ARITHMETIC EXPRESS- 00080020 ! 12: C IONS ARE ALL USED TO TEST THE STATEMENT FUNCTION DEFINITION AND 00090020 ! 13: C THE VALUE RETURNED FOR THE STATEMENT FUNCTION WHEN IT IS USED 00100020 ! 14: C IN THE MAIN BODY OF THE PROGRAM. 00110020 ! 15: C 00120020 ! 16: C REFERENCES 00130020 ! 17: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140020 ! 18: C X3.9-1978 00150020 ! 19: C 00160020 ! 20: C SECTION 8.4.1, INTEGER, REAL, DOUBLE PRECISION, COMPLEX, AND 00170020 ! 21: C LOGICAL TYPE-STATEMENTS 00180020 ! 22: C SECTION 15.3.2, INTRINSIC FUNCTION REFERENCES 00190020 ! 23: C SECTION 15.4, STATEMENT FUNCTIONS 00200020 ! 24: C SECTION 15.4.1, FORMS OF A FUNCTION STATEMENT 00210020 ! 25: C SECTION 15.4.2, REFERENCING A STATEMENT FUNCTION 00220020 ! 26: C SECTION 15.5.2, EXTERNAL FUNCTION REFERENCES 00230020 ! 27: C 00240020 ! 28: LOGICAL LFTN01, LDTN01 00250020 ! 29: LOGICAL LFTN02, LDTN02 00260020 ! 30: LOGICAL LFTN03, LDTN03, LCTN03 00270020 ! 31: LOGICAL LFTN04, LDTN04, LCTN04 00280020 ! 32: DIMENSION IADN11(2) 00290020 ! 33: C 00300020 ! 34: C..... TEST 553 00310020 ! 35: IFON01(IDON01) = 32767 00320020 ! 36: C 00330020 ! 37: C..... TEST 554 00340020 ! 38: LFTN01(LDTN01) = .TRUE. 00350020 ! 39: C 00360020 ! 40: C..... TEST 555 00370020 ! 41: IFON02 ( IDON02 ) = IDON02 00380020 ! 42: C 00390020 ! 43: C..... TEST 556 00400020 ! 44: LFTN02( LDTN02 ) = LDTN02 00410020 ! 45: C 00420020 ! 46: C..... TEST 557 00430020 ! 47: IFON03 (IDON03 )= IDON03 00440020 ! 48: C 00450020 ! 49: C..... TEST 558 00460020 ! 50: LFTN03(LDTN03) = LDTN03 00470020 ! 51: C 00480020 ! 52: C..... TEST 559 00490020 ! 53: LFTN04(LDTN04) = .NOT. LDTN04 00500020 ! 54: C 00510020 ! 55: C..... TEST 560 00520020 ! 56: IFON04(IDON04) = IDON04 ** 2 00530020 ! 57: C 00540020 ! 58: C..... TEST 561 00550020 ! 59: IFON05(IDON05, IDON06) = IDON05 + IDON06 00560020 ! 60: C 00570020 ! 61: C..... TEST 562 00580020 ! 62: IFON06(IDON07, IDON08) = SQRT(FLOAT(IDON07**2)+FLOAT(IDON08**2)) 00590020 ! 63: C 00600020 ! 64: C..... TEST 563 00610020 ! 65: IFON07(IDON09) = IDON09 ** 2 00620020 ! 66: IFON08(I,J)=SQRT(FLOAT(IFON07(I))+FLOAT(IFON07(J))) 00630020 ! 67: C 00640020 ! 68: C..... TEST 564 00650020 ! 69: IFON09(K,L) = K / L + K ** L - K * L 00660020 ! 70: C 00670020 ! 71: C 00680020 ! 72: C 00690020 ! 73: C ********************************************************** 00700020 ! 74: C 00710020 ! 75: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00720020 ! 76: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00730020 ! 77: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00740020 ! 78: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00750020 ! 79: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00760020 ! 80: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00770020 ! 81: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00780020 ! 82: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00790020 ! 83: C OF EXECUTING THESE TESTS. 00800020 ! 84: C 00810020 ! 85: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00820020 ! 86: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00830020 ! 87: C 00840020 ! 88: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00850020 ! 89: C 00860020 ! 90: C DEPARTMENT OF THE NAVY 00870020 ! 91: C FEDERAL COBOL COMPILER TESTING SERVICE 00880020 ! 92: C WASHINGTON, D.C. 20376 00890020 ! 93: C 00900020 ! 94: C ********************************************************** 00910020 ! 95: C 00920020 ! 96: C 00930020 ! 97: C 00940020 ! 98: C INITIALIZATION SECTION 00950020 ! 99: C 00960020 ! 100: C INITIALIZE CONSTANTS 00970020 ! 101: C ************** 00980020 ! 102: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00990020 ! 103: I01 = 5 01000020 ! 104: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01010020 ! 105: I02 = 6 01020020 ! 106: C SYSTEM ENVIRONMENT SECTION 01030020 ! 107: C 01040020 ! 108: I01 = 5 01050020 ! 109: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01060020 ! 110: C (UNIT NUMBER FOR CARD READER). 01070020 ! 111: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01080020 ! 112: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01090020 ! 113: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01100020 ! 114: C 01110020 ! 115: I02 = 6 01120020 ! 116: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01130020 ! 117: C (UNIT NUMBER FOR PRINTER). 01140020 ! 118: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01150020 ! 119: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01160020 ! 120: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01170020 ! 121: C 01180020 ! 122: IVPASS=0 01190020 ! 123: IVFAIL=0 01200020 ! 124: IVDELE=0 01210020 ! 125: ICZERO=0 01220020 ! 126: C 01230020 ! 127: C WRITE PAGE HEADERS 01240020 ! 128: WRITE (I02,90000) 01250020 ! 129: WRITE (I02,90001) 01260020 ! 130: WRITE (I02,90002) 01270020 ! 131: WRITE (I02, 90002) 01280020 ! 132: WRITE (I02,90003) 01290020 ! 133: WRITE (I02,90002) 01300020 ! 134: WRITE (I02,90004) 01310020 ! 135: WRITE (I02,90002) 01320020 ! 136: WRITE (I02,90011) 01330020 ! 137: WRITE (I02,90002) 01340020 ! 138: WRITE (I02,90002) 01350020 ! 139: WRITE (I02,90005) 01360020 ! 140: WRITE (I02,90006) 01370020 ! 141: WRITE (I02,90002) 01380020 ! 142: IVTNUM = 553 01390020 ! 143: C 01400020 ! 144: C **** TEST 553 **** 01410020 ! 145: C TEST 553 - THE VALUE OF THE INTEGER FUNCTION IS SET TO A 01420020 ! 146: C CONSTANT OF 32767 REGARDLESS OF THE VALUE OF THE ARGUEMENT 01430020 ! 147: C SUPPLIED TO THE DUMMY ARGUEMENT. TEST OF POSITIVE INTEGER 01440020 ! 148: C CONSTANTS FOR A STATEMENT FUNCTION. 01450020 ! 149: C 01460020 ! 150: C 01470020 ! 151: IF (ICZERO) 35530, 5530, 35530 01480020 ! 152: 5530 CONTINUE 01490020 ! 153: IVCOMP = IFON01(3) 01500020 ! 154: GO TO 45530 01510020 ! 155: 35530 IVDELE = IVDELE + 1 01520020 ! 156: WRITE (I02,80003) IVTNUM 01530020 ! 157: IF (ICZERO) 45530, 5541, 45530 01540020 ! 158: 45530 IF ( IVCOMP - 32767 ) 25530, 15530, 25530 01550020 ! 159: 15530 IVPASS = IVPASS + 1 01560020 ! 160: WRITE (I02,80001) IVTNUM 01570020 ! 161: GO TO 5541 01580020 ! 162: 25530 IVFAIL = IVFAIL + 1 01590020 ! 163: IVCORR = 32767 01600020 ! 164: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01610020 ! 165: 5541 CONTINUE 01620020 ! 166: IVTNUM = 554 01630020 ! 167: C 01640020 ! 168: C **** TEST 554 **** 01650020 ! 169: C TEST 554 - TEST OF THE STATEMENT FUNCTION OF TYPE LOGICAL 01660020 ! 170: C SET TO THE LOGICAL CONSTANT .TRUE. REGARDLESS OF THE 01670020 ! 171: C ARGUEMENT SUPPLIED TO THE DUMMY ARGUEMENT. 01680020 ! 172: C A LOGICAL IF STATEMENT IS USED IN CONJUNCTION WITH THE LOGICAL 01690020 ! 173: C STATEMENT FUNCTION. THE TRUE PATH IS TESTED. 01700020 ! 174: C 01710020 ! 175: C 01720020 ! 176: IF (ICZERO) 35540, 5540, 35540 01730020 ! 177: 5540 CONTINUE 01740020 ! 178: IVON01 = 0 01750020 ! 179: IF ( LFTN01(.FALSE.) ) IVON01 = 1 01760020 ! 180: GO TO 45540 01770020 ! 181: 35540 IVDELE = IVDELE + 1 01780020 ! 182: WRITE (I02,80003) IVTNUM 01790020 ! 183: IF (ICZERO) 45540, 5551, 45540 01800020 ! 184: 45540 IF ( IVON01 - 1 ) 25540, 15540, 25540 01810020 ! 185: 15540 IVPASS = IVPASS + 1 01820020 ! 186: WRITE (I02,80001) IVTNUM 01830020 ! 187: GO TO 5551 01840020 ! 188: 25540 IVFAIL = IVFAIL + 1 01850020 ! 189: IVCOMP = IVON01 01860020 ! 190: IVCORR = 1 01870020 ! 191: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01880020 ! 192: 5551 CONTINUE 01890020 ! 193: IVTNUM = 555 01900020 ! 194: C 01910020 ! 195: C **** TEST 555 **** 01920020 ! 196: C TEST 555 - THE INTEGER STATEMENT FUNCTION IS SET TO THE VALUE 01930020 ! 197: C OF THE ARGEUMENT SUPPLIED. 01940020 ! 198: C 01950020 ! 199: C 01960020 ! 200: IF (ICZERO) 35550, 5550, 35550 01970020 ! 201: 5550 CONTINUE 01980020 ! 202: IVCOMP = IFON02 ( 32767 ) 01990020 ! 203: GO TO 45550 02000020 ! 204: 35550 IVDELE = IVDELE + 1 02010020 ! 205: WRITE (I02,80003) IVTNUM 02020020 ! 206: IF (ICZERO) 45550, 5561, 45550 02030020 ! 207: 45550 IF ( IVCOMP - 32767 ) 25550, 15550, 25550 02040020 ! 208: 15550 IVPASS = IVPASS + 1 02050020 ! 209: WRITE (I02,80001) IVTNUM 02060020 ! 210: GO TO 5561 02070020 ! 211: 25550 IVFAIL = IVFAIL + 1 02080020 ! 212: IVCORR = 32767 02090020 ! 213: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02100020 ! 214: 5561 CONTINUE 02110020 ! 215: IVTNUM = 556 02120020 ! 216: C 02130020 ! 217: C **** TEST 556 **** 02140020 ! 218: C TEST 556 - TEST OF A LOGICAL STATEMENT FUNCTION SET TO THE 02150020 ! 219: C VALUE OF THE ARGUEMENT SUPPLIED. THE FALSE PATH OF A LOGICAL 02160020 ! 220: C IF STATEMENT IS USED IN CONJUNCTION WITH THE LOGICAL 02170020 ! 221: C STATEMENT FUNCTION. 02180020 ! 222: C 02190020 ! 223: C 02200020 ! 224: IF (ICZERO) 35560, 5560, 35560 02210020 ! 225: 5560 CONTINUE 02220020 ! 226: IVON01 = 1 02230020 ! 227: IF ( LFTN02(.FALSE.) ) IVON01 = 0 02240020 ! 228: GO TO 45560 02250020 ! 229: 35560 IVDELE = IVDELE + 1 02260020 ! 230: WRITE (I02,80003) IVTNUM 02270020 ! 231: IF (ICZERO) 45560, 5571, 45560 02280020 ! 232: 45560 IF ( IVON01 - 1 ) 25560, 15560, 25560 02290020 ! 233: 15560 IVPASS = IVPASS + 1 02300020 ! 234: WRITE (I02,80001) IVTNUM 02310020 ! 235: GO TO 5571 02320020 ! 236: 25560 IVFAIL = IVFAIL + 1 02330020 ! 237: IVCOMP = IVON01 02340020 ! 238: IVCORR = 1 02350020 ! 239: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02360020 ! 240: 5571 CONTINUE 02370020 ! 241: IVTNUM = 557 02380020 ! 242: C 02390020 ! 243: C **** TEST 557 **** 02400020 ! 244: C TEST 557 - THE VALUE OF AN INTEGER FUNCTION IS SET EQUAL TO 02410020 ! 245: C VALUE OF THE ARGUEMENT SUPPLIED. THIS VALUE IS AN INTEGER 02420020 ! 246: C VARIABLE SET TO 32767. 02430020 ! 247: C 02440020 ! 248: C 02450020 ! 249: IF (ICZERO) 35570, 5570, 35570 02460020 ! 250: 5570 CONTINUE 02470020 ! 251: ICON01 = 32767 02480020 ! 252: IVCOMP = IFON03 ( ICON01 ) 02490020 ! 253: GO TO 45570 02500020 ! 254: 35570 IVDELE = IVDELE + 1 02510020 ! 255: WRITE (I02,80003) IVTNUM 02520020 ! 256: IF (ICZERO) 45570, 5581, 45570 02530020 ! 257: 45570 IF ( IVCOMP - 32767 ) 25570, 15570, 25570 02540020 ! 258: 15570 IVPASS = IVPASS + 1 02550020 ! 259: WRITE (I02,80001) IVTNUM 02560020 ! 260: GO TO 5581 02570020 ! 261: 25570 IVFAIL = IVFAIL + 1 02580020 ! 262: IVCORR = 32767 02590020 ! 263: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02600020 ! 264: 5581 CONTINUE 02610020 ! 265: IVTNUM = 558 02620020 ! 266: C 02630020 ! 267: C **** TEST 558 **** 02640020 ! 268: C TEST 558 - A LOGICAL STATEMENT FUNCTION IS SET EQUAL TO THE 02650020 ! 269: C VALUE OF THE ARGUEMENT SUPPLIED. THIS VALUE IS A LOGICAL 02660020 ! 270: C VARIABLE SET TO .TRUE. THE TRUE PATH OF A LOGICAL IF 02670020 ! 271: C STATEMENT IS USED IN CONJUNCTION WITH THE LOGICAL STATEMENT 02680020 ! 272: C FUNCTION. 02690020 ! 273: C 02700020 ! 274: C 02710020 ! 275: IF (ICZERO) 35580, 5580, 35580 02720020 ! 276: 5580 CONTINUE 02730020 ! 277: IVON01 = 0 02740020 ! 278: LCTN03 = .TRUE. 02750020 ! 279: IF ( LFTN03(LCTN03) ) IVON01 = 1 02760020 ! 280: GO TO 45580 02770020 ! 281: 35580 IVDELE = IVDELE + 1 02780020 ! 282: WRITE (I02,80003) IVTNUM 02790020 ! 283: IF (ICZERO) 45580, 5591, 45580 02800020 ! 284: 45580 IF ( IVON01 - 1 ) 25580, 15580, 25580 02810020 ! 285: 15580 IVPASS = IVPASS + 1 02820020 ! 286: WRITE (I02,80001) IVTNUM 02830020 ! 287: GO TO 5591 02840020 ! 288: 25580 IVFAIL = IVFAIL + 1 02850020 ! 289: IVCOMP = IVON01 02860020 ! 290: IVCORR = 1 02870020 ! 291: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02880020 ! 292: 5591 CONTINUE 02890020 ! 293: IVTNUM = 559 02900020 ! 294: C 02910020 ! 295: C **** TEST 559 **** 02920020 ! 296: C TEST 559 - LIKE TEST 558 ONLY THE LOGICAL .NOT. IS USED 02930020 ! 297: C IN THE LOGICAL STATEMENT FUNCTION DEFINITION THE FALSE PATH 02940020 ! 298: C OF A LOGICAL IF STATEMENT IS USED IN CONJUNCTION WITH THE 02950020 ! 299: C LOGICAL STATEMENT FUNCTION. 02960020 ! 300: C 02970020 ! 301: C 02980020 ! 302: IF (ICZERO) 35590, 5590, 35590 02990020 ! 303: 5590 CONTINUE 03000020 ! 304: IVON01 = 1 03010020 ! 305: LCTN04 = .TRUE. 03020020 ! 306: IF ( LFTN04(LCTN04) ) IVON01 = 0 03030020 ! 307: GO TO 45590 03040020 ! 308: 35590 IVDELE = IVDELE + 1 03050020 ! 309: WRITE (I02,80003) IVTNUM 03060020 ! 310: IF (ICZERO) 45590, 5601, 45590 03070020 ! 311: 45590 IF ( IVON01 - 1 ) 25590, 15590, 25590 03080020 ! 312: 15590 IVPASS = IVPASS + 1 03090020 ! 313: WRITE (I02,80001) IVTNUM 03100020 ! 314: GO TO 5601 03110020 ! 315: 25590 IVFAIL = IVFAIL + 1 03120020 ! 316: IVCOMP = IVON01 03130020 ! 317: IVCORR = 1 03140020 ! 318: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03150020 ! 319: 5601 CONTINUE 03160020 ! 320: IVTNUM = 560 03170020 ! 321: C 03180020 ! 322: C **** TEST 560 **** 03190020 ! 323: C TEST 560 - INTEGER EXPONIENTIATION USED IN AN INTEGER 03200020 ! 324: C STATEMENT FUNCTION. 03210020 ! 325: C 03220020 ! 326: C 03230020 ! 327: IF (ICZERO) 35600, 5600, 35600 03240020 ! 328: 5600 CONTINUE 03250020 ! 329: ICON04 = 3 03260020 ! 330: IVCOMP = IFON04(ICON04) 03270020 ! 331: GO TO 45600 03280020 ! 332: 35600 IVDELE = IVDELE + 1 03290020 ! 333: WRITE (I02,80003) IVTNUM 03300020 ! 334: IF (ICZERO) 45600, 5611, 45600 03310020 ! 335: 45600 IF ( IVCOMP - 9 ) 25600, 15600, 25600 03320020 ! 336: 15600 IVPASS = IVPASS + 1 03330020 ! 337: WRITE (I02,80001) IVTNUM 03340020 ! 338: GO TO 5611 03350020 ! 339: 25600 IVFAIL = IVFAIL + 1 03360020 ! 340: IVCORR = 9 03370020 ! 341: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03380020 ! 342: 5611 CONTINUE 03390020 ! 343: IVTNUM = 561 03400020 ! 344: C 03410020 ! 345: C **** TEST 561 **** 03420020 ! 346: C TEST 561 - TEST OF INTEGER ADDITION USING TWO (2) DUMMY 03430020 ! 347: C ARGUEMENTS. 03440020 ! 348: C 03450020 ! 349: C 03460020 ! 350: IF (ICZERO) 35610, 5610, 35610 03470020 ! 351: 5610 CONTINUE 03480020 ! 352: ICON05 = 9 03490020 ! 353: ICON06 = 16 03500020 ! 354: IVCOMP = IFON05(ICON05, ICON06) 03510020 ! 355: GO TO 45610 03520020 ! 356: 35610 IVDELE = IVDELE + 1 03530020 ! 357: WRITE (I02,80003) IVTNUM 03540020 ! 358: IF (ICZERO) 45610, 5621, 45610 03550020 ! 359: 45610 IF ( IVCOMP - 25 ) 25610, 15610, 25610 03560020 ! 360: 15610 IVPASS = IVPASS + 1 03570020 ! 361: WRITE (I02,80001) IVTNUM 03580020 ! 362: GO TO 5621 03590020 ! 363: 25610 IVFAIL = IVFAIL + 1 03600020 ! 364: IVCORR = 25 03610020 ! 365: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03620020 ! 366: 5621 CONTINUE 03630020 ! 367: IVTNUM = 562 03640020 ! 368: C 03650020 ! 369: C **** TEST 562 **** 03660020 ! 370: C TEST 562 - THIS TEST IS THE SOLUTION OF A RIGHT TRIANGLE 03670020 ! 371: C USING INTEGER STATEMENT FUNCTIONS WHICH REFERENCE THE 03680020 ! 372: C INTRINSIC FUNCTIONS SQRT AND FLOAT. THIS IS A 3-4-5 03690020 ! 373: C RIGHT TRIANGLE. 03700020 ! 374: C 03710020 ! 375: C 03720020 ! 376: IF (ICZERO) 35620, 5620, 35620 03730020 ! 377: 5620 CONTINUE 03740020 ! 378: ICON07 = 3 03750020 ! 379: ICON08 = 4 03760020 ! 380: IVCOMP = IFON06(ICON07, ICON08) 03770020 ! 381: GO TO 45620 03780020 ! 382: 35620 IVDELE = IVDELE + 1 03790020 ! 383: WRITE (I02,80003) IVTNUM 03800020 ! 384: IF (ICZERO) 45620, 5631, 45620 03810020 ! 385: 45620 IF ( IVCOMP - 5 ) 5622, 15620, 5622 03820020 ! 386: 5622 IF ( IVCOMP - 4 ) 25620, 15620, 25620 03830020 ! 387: 15620 IVPASS = IVPASS + 1 03840020 ! 388: WRITE (I02,80001) IVTNUM 03850020 ! 389: GO TO 5631 03860020 ! 390: 25620 IVFAIL = IVFAIL + 1 03870020 ! 391: IVCORR = 5 03880020 ! 392: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03890020 ! 393: 5631 CONTINUE 03900020 ! 394: IVTNUM = 563 03910020 ! 395: C 03920020 ! 396: C **** TEST 563 **** 03930020 ! 397: C TEST 563 - SOLUTION OF A 3-4-5 RIGHT TRIANGLE LIKE TEST 562 03940020 ! 398: C EXCEPT THAT BOTH INTRINSIC AND PREVIOUSLY DEFINED STATEMENT 03950020 ! 399: C FUNCTIONS ARE USED. 03960020 ! 400: C 03970020 ! 401: C 03980020 ! 402: IF (ICZERO) 35630, 5630, 35630 03990020 ! 403: 5630 CONTINUE 04000020 ! 404: ICON09 = 3 04010020 ! 405: ICON10 = 4 04020020 ! 406: IVCOMP = IFON08(ICON09, ICON10) 04030020 ! 407: GO TO 45630 04040020 ! 408: 35630 IVDELE = IVDELE + 1 04050020 ! 409: WRITE (I02,80003) IVTNUM 04060020 ! 410: IF (ICZERO) 45630, 5641, 45630 04070020 ! 411: 45630 IF ( IVCOMP - 5 ) 5632, 15630, 5632 04080020 ! 412: 5632 IF ( IVCOMP - 4 ) 25630, 15630, 25630 04090020 ! 413: 15630 IVPASS = IVPASS + 1 04100020 ! 414: WRITE (I02,80001) IVTNUM 04110020 ! 415: GO TO 5641 04120020 ! 416: 25630 IVFAIL = IVFAIL + 1 04130020 ! 417: IVCORR = 5 04140020 ! 418: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04150020 ! 419: 5641 CONTINUE 04160020 ! 420: IVTNUM = 564 04170020 ! 421: C 04180020 ! 422: C **** TEST 564 **** 04190020 ! 423: C TEST 564 - USE OF ARRAY ELEMENTS IN AN INTEGER STATEMENT 04200020 ! 424: C FUNCTION WHICH USES THE OPERATIONS OF + - * / . 04210020 ! 425: C 04220020 ! 426: C 04230020 ! 427: IF (ICZERO) 35640, 5640, 35640 04240020 ! 428: 5640 CONTINUE 04250020 ! 429: IADN11(1) = 2 04260020 ! 430: IADN11(2) = 2 04270020 ! 431: IVCOMP = IFON09( IADN11(1), IADN11(2) ) 04280020 ! 432: GO TO 45640 04290020 ! 433: 35640 IVDELE = IVDELE + 1 04300020 ! 434: WRITE (I02,80003) IVTNUM 04310020 ! 435: IF (ICZERO) 45640, 5651, 45640 04320020 ! 436: 45640 IF ( IVCOMP - 1 ) 25640, 15640, 25640 04330020 ! 437: 15640 IVPASS = IVPASS + 1 04340020 ! 438: WRITE (I02,80001) IVTNUM 04350020 ! 439: GO TO 5651 04360020 ! 440: 25640 IVFAIL = IVFAIL + 1 04370020 ! 441: IVCORR = 1 04380020 ! 442: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04390020 ! 443: 5651 CONTINUE 04400020 ! 444: C 04410020 ! 445: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 04420020 ! 446: 99999 CONTINUE 04430020 ! 447: WRITE (I02,90002) 04440020 ! 448: WRITE (I02,90006) 04450020 ! 449: WRITE (I02,90002) 04460020 ! 450: WRITE (I02,90002) 04470020 ! 451: WRITE (I02,90007) 04480020 ! 452: WRITE (I02,90002) 04490020 ! 453: WRITE (I02,90008) IVFAIL 04500020 ! 454: WRITE (I02,90009) IVPASS 04510020 ! 455: WRITE (I02,90010) IVDELE 04520020 ! 456: C 04530020 ! 457: C 04540020 ! 458: C TERMINATE ROUTINE EXECUTION 04550020 ! 459: STOP 04560020 ! 460: C 04570020 ! 461: C FORMAT STATEMENTS FOR PAGE HEADERS 04580020 ! 462: 90000 FORMAT (1H1) 04590020 ! 463: 90002 FORMAT (1H ) 04600020 ! 464: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04610020 ! 465: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 04620020 ! 466: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 04630020 ! 467: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 04640020 ! 468: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 04650020 ! 469: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 04660020 ! 470: C 04670020 ! 471: C FORMAT STATEMENTS FOR RUN SUMMARIES 04680020 ! 472: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 04690020 ! 473: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 04700020 ! 474: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 04710020 ! 475: C 04720020 ! 476: C FORMAT STATEMENTS FOR TEST RESULTS 04730020 ! 477: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 04740020 ! 478: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 04750020 ! 479: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 04760020 ! 480: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 04770020 ! 481: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 04780020 ! 482: C 04790020 ! 483: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM020) 04800020 ! 484: END 04810020
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.