![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM023.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 FM023.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: C COMMENT SECTION. 00010023 ! 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 00020023 ! 6: C FM023 00030023 ! 7: C 00040023 ! 8: C TWO DIMENSIONED ARRAYS ARE USED IN THIS ROUTINE. 00050023 ! 9: C THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS00060023 ! 10: C SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT. THE VALUES 00070023 ! 11: C OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE 00080023 ! 12: C ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS 00090023 ! 13: C (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO 00100023 ! 14: C INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY 00110023 ! 15: C USE OF THE EQUIVALENCE STATEMENT. 00120023 ! 16: C 00130023 ! 17: C 00140023 ! 18: C REFERENCES 00150023 ! 19: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160023 ! 20: C X3.9-1978 00170023 ! 21: C 00180023 ! 22: C SECTION 8, SPECIFICATION STATEMENTS 00190023 ! 23: C SECTION 8.1, DIMENSION STATEMENT 00200023 ! 24: C SECTION 8.2, EQUIVALENCE STATEMENT 00210023 ! 25: C SECTION 8.3, COMMON STATEMENT 00220023 ! 26: C SECTION 8.4, TYPE-STATEMENTS 00230023 ! 27: C SECTION 9, DATA STATEMENT 00240023 ! 28: C 00250023 ! 29: COMMON IADN22(2,2), RADN22(2,2), ICOE01, RCOE01 00260023 ! 30: DIMENSION IADN21(2,2), RADN21(2,2) 00270023 ! 31: DIMENSION IADE23(2,2), IADE24(2,2), RADE23(2,2), RADE24(2,2) 00280023 ! 32: EQUIVALENCE (IADE23(2,2),IADN22(2,2),IADE24(2,2)) 00290023 ! 33: EQUIVALENCE (RADE23(2,2),RADN22(2,2),RADE24(2,2)) 00300023 ! 34: EQUIVALENCE (ICOE01,ICOE02,ICOE03,ICOE04), (RCOE01,RCOE02,RCOE03) 00310023 ! 35: INTEGER RADN11(2), RADN25(2,2) 00320023 ! 36: LOGICAL LADN21(2,2) 00330023 ! 37: DATA RADN21(2,2)/-512./ 00340023 ! 38: DATA LADN21/4*.TRUE./ 00350023 ! 39: C 00360023 ! 40: C ********************************************************** 00370023 ! 41: C 00380023 ! 42: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00390023 ! 43: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00400023 ! 44: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00410023 ! 45: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00420023 ! 46: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00430023 ! 47: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00440023 ! 48: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00450023 ! 49: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00460023 ! 50: C OF EXECUTING THESE TESTS. 00470023 ! 51: C 00480023 ! 52: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00490023 ! 53: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00500023 ! 54: C 00510023 ! 55: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00520023 ! 56: C 00530023 ! 57: C DEPARTMENT OF THE NAVY 00540023 ! 58: C FEDERAL COBOL COMPILER TESTING SERVICE 00550023 ! 59: C WASHINGTON, D.C. 20376 00560023 ! 60: C 00570023 ! 61: C ********************************************************** 00580023 ! 62: C 00590023 ! 63: C 00600023 ! 64: C 00610023 ! 65: C INITIALIZATION SECTION 00620023 ! 66: C 00630023 ! 67: C INITIALIZE CONSTANTS 00640023 ! 68: C ************** 00650023 ! 69: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660023 ! 70: I01 = 5 00670023 ! 71: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680023 ! 72: I02 = 6 00690023 ! 73: C SYSTEM ENVIRONMENT SECTION 00700023 ! 74: C 00710023 ! 75: I01 = 5 00720023 ! 76: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00730023 ! 77: C (UNIT NUMBER FOR CARD READER). 00740023 ! 78: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00750023 ! 79: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00760023 ! 80: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00770023 ! 81: C 00780023 ! 82: I02 = 6 00790023 ! 83: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00800023 ! 84: C (UNIT NUMBER FOR PRINTER). 00810023 ! 85: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00820023 ! 86: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00830023 ! 87: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00840023 ! 88: C 00850023 ! 89: IVPASS=0 00860023 ! 90: IVFAIL=0 00870023 ! 91: IVDELE=0 00880023 ! 92: ICZERO=0 00890023 ! 93: C 00900023 ! 94: C WRITE PAGE HEADERS 00910023 ! 95: WRITE (I02,90000) 00920023 ! 96: WRITE (I02,90001) 00930023 ! 97: WRITE (I02,90002) 00940023 ! 98: WRITE (I02, 90002) 00950023 ! 99: WRITE (I02,90003) 00960023 ! 100: WRITE (I02,90002) 00970023 ! 101: WRITE (I02,90004) 00980023 ! 102: WRITE (I02,90002) 00990023 ! 103: WRITE (I02,90011) 01000023 ! 104: WRITE (I02,90002) 01010023 ! 105: WRITE (I02,90002) 01020023 ! 106: WRITE (I02,90005) 01030023 ! 107: WRITE (I02,90006) 01040023 ! 108: WRITE (I02,90002) 01050023 ! 109: IVTNUM = 632 01060023 ! 110: C 01070023 ! 111: C **** TEST 632 **** 01080023 ! 112: C TEST 632 - TESTS SETTING AN INTEGER ARRAY ELEMENT BY A 01090023 ! 113: C SIMPLE ASSIGNMENT STATEMENT TO THE VALUE 9999. 01100023 ! 114: C 01110023 ! 115: IF (ICZERO) 36320, 6320, 36320 01120023 ! 116: 6320 CONTINUE 01130023 ! 117: IADN21(1,1) = 9999 01140023 ! 118: IVCOMP = IADN21(1,1) 01150023 ! 119: GO TO 46320 01160023 ! 120: 36320 IVDELE = IVDELE + 1 01170023 ! 121: WRITE (I02,80003) IVTNUM 01180023 ! 122: IF (ICZERO) 46320, 6331, 46320 01190023 ! 123: 46320 IF ( IVCOMP - 9999 ) 26320, 16320, 26320 01200023 ! 124: 16320 IVPASS = IVPASS + 1 01210023 ! 125: WRITE (I02,80001) IVTNUM 01220023 ! 126: GO TO 6331 01230023 ! 127: 26320 IVFAIL = IVFAIL + 1 01240023 ! 128: IVCORR = 9999 01250023 ! 129: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01260023 ! 130: 6331 CONTINUE 01270023 ! 131: IVTNUM = 633 01280023 ! 132: C 01290023 ! 133: C **** TEST 633 **** 01300023 ! 134: C TEST 633 - TESTS SETTING A REAL ARRAY ELEMENT BY A SIMPLE 01310023 ! 135: C ASSIGNMENT STATEMENT TO THE VALUE -32766. 01320023 ! 136: C 01330023 ! 137: IF (ICZERO) 36330, 6330, 36330 01340023 ! 138: 6330 CONTINUE 01350023 ! 139: RADN21(1,2) = -32766. 01360023 ! 140: IVCOMP = RADN21(1,2) 01370023 ! 141: GO TO 46330 01380023 ! 142: 36330 IVDELE = IVDELE + 1 01390023 ! 143: WRITE (I02,80003) IVTNUM 01400023 ! 144: IF (ICZERO) 46330, 6341, 46330 01410023 ! 145: 46330 IF ( IVCOMP + 32766 ) 26330, 16330, 26330 01420023 ! 146: 16330 IVPASS = IVPASS + 1 01430023 ! 147: WRITE (I02,80001) IVTNUM 01440023 ! 148: GO TO 6341 01450023 ! 149: 26330 IVFAIL = IVFAIL + 1 01460023 ! 150: IVCORR = -32766 01470023 ! 151: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01480023 ! 152: 6341 CONTINUE 01490023 ! 153: IVTNUM = 634 01500023 ! 154: C 01510023 ! 155: C **** TEST 634 **** 01520023 ! 156: C TEST 634 - TEST OF THE DATA INITIALIZATION STATEMENT AND SETTING01530023 ! 157: C AN INTEGER ARRAY ELEMENT EQUAL TO THE VALUE OF A REAL ARRAY 01540023 ! 158: C ELEMENT. THE VALUE USED IS -512. 01550023 ! 159: C 01560023 ! 160: IF (ICZERO) 36340, 6340, 36340 01570023 ! 161: 6340 CONTINUE 01580023 ! 162: IADN21(2,2) = RADN21(2,2) 01590023 ! 163: IVCOMP = IADN21(2,2) 01600023 ! 164: GO TO 46340 01610023 ! 165: 36340 IVDELE = IVDELE + 1 01620023 ! 166: WRITE (I02,80003) IVTNUM 01630023 ! 167: IF (ICZERO) 46340, 6351, 46340 01640023 ! 168: 46340 IF ( IVCOMP + 512 ) 26340, 16340, 26340 01650023 ! 169: 16340 IVPASS = IVPASS + 1 01660023 ! 170: WRITE (I02,80001) IVTNUM 01670023 ! 171: GO TO 6351 01680023 ! 172: 26340 IVFAIL = IVFAIL + 1 01690023 ! 173: IVCORR = -512 01700023 ! 174: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01710023 ! 175: 6351 CONTINUE 01720023 ! 176: IVTNUM = 635 01730023 ! 177: C 01740023 ! 178: C **** TEST 635 **** 01750023 ! 179: C TEST 635 - TEST OF SETTING A TWO DIMENSIONED ARRAY ELEMENT 01760023 ! 180: C EQUAL TO THE VALUE OF A ONE DIMENSIONED ARRAY ELEMENT. 01770023 ! 181: C BOTH ARRAYS ARE SET INTEGER BY THE TYPE STATEMENT AND THE TWO 01780023 ! 182: C DIMENSIONED ARRAY ELEMENT IS MINUS THE VALUE OF THE ONE DIMENSION 01790023 ! 183: C ELEMENT. THE VALUE USED IS 3. 01800023 ! 184: C 01810023 ! 185: IF (ICZERO) 36350, 6350, 36350 01820023 ! 186: 6350 CONTINUE 01830023 ! 187: RADN11(1) = 3 01840023 ! 188: RADN25(2,2) = - RADN11(1) 01850023 ! 189: IVCOMP = RADN25(2,2) 01860023 ! 190: GO TO 46350 01870023 ! 191: 36350 IVDELE = IVDELE + 1 01880023 ! 192: WRITE (I02,80003) IVTNUM 01890023 ! 193: IF (ICZERO) 46350, 6361, 46350 01900023 ! 194: 46350 IF ( IVCOMP + 3 ) 26350, 16350, 26350 01910023 ! 195: 16350 IVPASS = IVPASS + 1 01920023 ! 196: WRITE (I02,80001) IVTNUM 01930023 ! 197: GO TO 6361 01940023 ! 198: 26350 IVFAIL = IVFAIL + 1 01950023 ! 199: IVCORR = -3 01960023 ! 200: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01970023 ! 201: 6361 CONTINUE 01980023 ! 202: IVTNUM = 636 01990023 ! 203: C 02000023 ! 204: C **** TEST 636 **** 02010023 ! 205: C TEST 636 - TEST OF LOGICAL ARRAY ELEMENTS SET BY DATA STATEMENTS02020023 ! 206: C 02030023 ! 207: IF (ICZERO) 36360, 6360, 36360 02040023 ! 208: 6360 CONTINUE 02050023 ! 209: ICON01 = 0 02060023 ! 210: IF ( LADN21(2,1) ) ICON01 = 1 02070023 ! 211: GO TO 46360 02080023 ! 212: 36360 IVDELE = IVDELE + 1 02090023 ! 213: WRITE (I02,80003) IVTNUM 02100023 ! 214: IF (ICZERO) 46360, 6371, 46360 02110023 ! 215: 46360 IF ( ICON01 - 1 ) 26360, 16360, 26360 02120023 ! 216: 16360 IVPASS = IVPASS + 1 02130023 ! 217: WRITE (I02,80001) IVTNUM 02140023 ! 218: GO TO 6371 02150023 ! 219: 26360 IVFAIL = IVFAIL + 1 02160023 ! 220: IVCOMP = ICON01 02170023 ! 221: IVCORR = 1 02180023 ! 222: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02190023 ! 223: 6371 CONTINUE 02200023 ! 224: IVTNUM = 637 02210023 ! 225: C 02220023 ! 226: C **** TEST 637 **** 02230023 ! 227: C TEST 637 - TEST OF REAL TO INTEGER CONVERSION AND SETTING 02240023 ! 228: C INTEGER ARRAY ELEMENTS TO THE VALUE OBTAINED IN AN ARITHMETIC 02250023 ! 229: C EXPRESSION USING REAL ARRAY ELEMENTS. .5 + .5 = 1 02260023 ! 230: C 02270023 ! 231: IF (ICZERO) 36370, 6370, 36370 02280023 ! 232: 6370 CONTINUE 02290023 ! 233: RADN21(1,2) = 00000.5 02300023 ! 234: RADN21(2,1) = .500000 02310023 ! 235: IADN21(2,1) = RADN21(1,2) + RADN21(2,1) 02320023 ! 236: IVCOMP = IADN21(2,1) 02330023 ! 237: GO TO 46370 02340023 ! 238: 36370 IVDELE = IVDELE + 1 02350023 ! 239: WRITE (I02,80003) IVTNUM 02360023 ! 240: IF (ICZERO) 46370, 6381, 46370 02370023 ! 241: 46370 IF ( IVCOMP - 1 ) 26370, 16370, 26370 02380023 ! 242: 16370 IVPASS = IVPASS + 1 02390023 ! 243: WRITE (I02,80001) IVTNUM 02400023 ! 244: GO TO 6381 02410023 ! 245: 26370 IVFAIL = IVFAIL + 1 02420023 ! 246: IVCORR = 1 02430023 ! 247: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02440023 ! 248: 6381 CONTINUE 02450023 ! 249: IVTNUM = 638 02460023 ! 250: C 02470023 ! 251: C **** TEST 638 **** 02480023 ! 252: C TEST 638 - TEST OF EQUIVALENCE OF THREE INTEGER ARRAYS ONE OF 02490023 ! 253: C WHICH IS IN COMMON. 02500023 ! 254: C 02510023 ! 255: IF (ICZERO) 36380, 6380, 36380 02520023 ! 256: 6380 CONTINUE 02530023 ! 257: IADN22(2,1) = -9999 02540023 ! 258: IVCOMP = IADE23(2,1) 02550023 ! 259: GO TO 46380 02560023 ! 260: 36380 IVDELE = IVDELE + 1 02570023 ! 261: WRITE (I02,80003) IVTNUM 02580023 ! 262: IF (ICZERO) 46380, 6391, 46380 02590023 ! 263: 46380 IF ( IVCOMP + 9999 ) 26380, 16380, 26380 02600023 ! 264: 16380 IVPASS = IVPASS + 1 02610023 ! 265: WRITE (I02,80001) IVTNUM 02620023 ! 266: GO TO 6391 02630023 ! 267: 26380 IVFAIL = IVFAIL + 1 02640023 ! 268: IVCORR = -9999 02650023 ! 269: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02660023 ! 270: 6391 CONTINUE 02670023 ! 271: IVTNUM = 639 02680023 ! 272: C 02690023 ! 273: C **** TEST 639 **** 02700023 ! 274: C TEST 639 - LIKE TEST 638 ONLY THE OTHER EQUIVALENCED ARRAY IS 02710023 ! 275: C TESTED FOR THE VALUE -9999. 02720023 ! 276: C 02730023 ! 277: IF (ICZERO) 36390, 6390, 36390 02740023 ! 278: 6390 CONTINUE 02750023 ! 279: IADE23(2,1) = -9999 02760023 ! 280: IVCOMP = IADE24(2,1) 02770023 ! 281: GO TO 46390 02780023 ! 282: 36390 IVDELE = IVDELE + 1 02790023 ! 283: WRITE (I02,80003) IVTNUM 02800023 ! 284: IF (ICZERO) 46390, 6401, 46390 02810023 ! 285: 46390 IF ( IVCOMP + 9999 ) 26390, 16390, 26390 02820023 ! 286: 16390 IVPASS = IVPASS + 1 02830023 ! 287: WRITE (I02,80001) IVTNUM 02840023 ! 288: GO TO 6401 02850023 ! 289: 26390 IVFAIL = IVFAIL + 1 02860023 ! 290: IVCORR = -9999 02870023 ! 291: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02880023 ! 292: 6401 CONTINUE 02890023 ! 293: IVTNUM = 640 02900023 ! 294: C 02910023 ! 295: C **** TEST 640 **** 02920023 ! 296: C TEST 640 - TEST OF THREE REAL ARRAYS THAT ARE EQUIVALENCED. 02930023 ! 297: C ONE OF THE ARRAYS IS IN COMMON. THE VALUE 512 IS SET INTO ONE OF 02940023 ! 298: C THE DIMENSIONED ARRAY ELEMENTS BY AN INTEGER TO REAL CONVERSION 02950023 ! 299: C ASSIGNMENT STATEMENT. 02960023 ! 300: C 02970023 ! 301: IF (ICZERO) 36400, 6400, 36400 02980023 ! 302: 6400 CONTINUE 02990023 ! 303: RADE24(2,2) = 512 03000023 ! 304: IVCOMP = RADN22(2,2) 03010023 ! 305: GO TO 46400 03020023 ! 306: 36400 IVDELE = IVDELE + 1 03030023 ! 307: WRITE (I02,80003) IVTNUM 03040023 ! 308: IF (ICZERO) 46400, 6411, 46400 03050023 ! 309: 46400 IF ( IVCOMP - 512 ) 26400, 16400, 26400 03060023 ! 310: 16400 IVPASS = IVPASS + 1 03070023 ! 311: WRITE (I02,80001) IVTNUM 03080023 ! 312: GO TO 6411 03090023 ! 313: 26400 IVFAIL = IVFAIL + 1 03100023 ! 314: IVCORR = 512 03110023 ! 315: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03120023 ! 316: 6411 CONTINUE 03130023 ! 317: IVTNUM = 641 03140023 ! 318: C 03150023 ! 319: C **** TEST 641 **** 03160023 ! 320: C TEST 641 - LIKE TEST 640 ONLY THE OTHER EQUIVALENCED ARRAY IS 03170023 ! 321: C TESTED FOR THE VALUE 512. 03180023 ! 322: C 03190023 ! 323: IF (ICZERO) 36410, 6410, 36410 03200023 ! 324: 6410 CONTINUE 03210023 ! 325: RADN22(2,2) = 512 03220023 ! 326: IVCOMP = RADE23(2,2) 03230023 ! 327: GO TO 46410 03240023 ! 328: 36410 IVDELE = IVDELE + 1 03250023 ! 329: WRITE (I02,80003) IVTNUM 03260023 ! 330: IF (ICZERO) 46410, 6421, 46410 03270023 ! 331: 46410 IF ( IVCOMP - 512 ) 26410, 16410, 26410 03280023 ! 332: 16410 IVPASS = IVPASS + 1 03290023 ! 333: WRITE (I02,80001) IVTNUM 03300023 ! 334: GO TO 6421 03310023 ! 335: 26410 IVFAIL = IVFAIL + 1 03320023 ! 336: IVCORR = 512 03330023 ! 337: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03340023 ! 338: 6421 CONTINUE 03350023 ! 339: IVTNUM = 642 03360023 ! 340: C 03370023 ! 341: C **** TEST 642 **** 03380023 ! 342: C TEST 642 - TEST OF FOUR INTEGER VARIABLES THAT ARE EQUIVALENCED.03390023 ! 343: C ONE OF THE INTEGER VARIABLES IS IN BLANK COMMON. THE VALUE USED 03400023 ! 344: C IS 3 SET BY AN ASSIGNMENT STATEMENT. 03410023 ! 345: C 03420023 ! 346: IF (ICZERO) 36420, 6420, 36420 03430023 ! 347: 6420 CONTINUE 03440023 ! 348: ICOE03 = 3 03450023 ! 349: IVCOMP = ICOE01 03460023 ! 350: GO TO 46420 03470023 ! 351: 36420 IVDELE = IVDELE + 1 03480023 ! 352: WRITE (I02,80003) IVTNUM 03490023 ! 353: IF (ICZERO) 46420, 6431, 46420 03500023 ! 354: 46420 IF ( IVCOMP - 3 ) 26420, 16420, 26420 03510023 ! 355: 16420 IVPASS = IVPASS + 1 03520023 ! 356: WRITE (I02,80001) IVTNUM 03530023 ! 357: GO TO 6431 03540023 ! 358: 26420 IVFAIL = IVFAIL + 1 03550023 ! 359: IVCORR = 3 03560023 ! 360: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03570023 ! 361: 6431 CONTINUE 03580023 ! 362: IVTNUM = 643 03590023 ! 363: C 03600023 ! 364: C **** TEST 643 **** 03610023 ! 365: C TEST 643 - LIKE TEST 642 BUT ANOTHER OF THE ELEMENTS IS TESTED 03620023 ! 366: C BY AN ARITHMETIC EXPRESSION USING THE EQUIVALENCED ELEMENTS. 03630023 ! 367: C THE VALUE OF ALL OF THE ELEMENTS SHOULD INITITIALLY BE 3 SINCE 03640023 ! 368: C THEY ALL SHOULD SHARE THE SAME STORAGE LOCATION. ICOE04 = 3+3+3+3 03650023 ! 369: C ICOE04 = 12 THEN THE ELEMENT ICOE02 IS TESTED FOR THE VALUE 12. 03660023 ! 370: C 03670023 ! 371: IF (ICZERO) 36430, 6430, 36430 03680023 ! 372: 6430 CONTINUE 03690023 ! 373: ICOE01 = 3 03700023 ! 374: ICOE04 = ICOE01 + ICOE02 + ICOE03 + ICOE04 03710023 ! 375: IVCOMP = ICOE02 03720023 ! 376: GO TO 46430 03730023 ! 377: 36430 IVDELE = IVDELE + 1 03740023 ! 378: WRITE (I02,80003) IVTNUM 03750023 ! 379: IF (ICZERO) 46430, 6441, 46430 03760023 ! 380: 46430 IF ( IVCOMP - 12 ) 26430, 16430, 26430 03770023 ! 381: 16430 IVPASS = IVPASS + 1 03780023 ! 382: WRITE (I02,80001) IVTNUM 03790023 ! 383: GO TO 6441 03800023 ! 384: 26430 IVFAIL = IVFAIL + 1 03810023 ! 385: IVCORR = 12 03820023 ! 386: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03830023 ! 387: 6441 CONTINUE 03840023 ! 388: IVTNUM = 644 03850023 ! 389: C 03860023 ! 390: C **** TEST 644 **** 03870023 ! 391: C TEST 644 - TEST OF EQUIVALENCE WITH THREE REAL VARIABLES ONE 03880023 ! 392: C OF WHICH IS IN BLANK COMMON. THE ELEMENTS ARE SET INITIALLY TO .503890023 ! 393: C THEN ALL OF THE ELEMENTS ARE USED IN AN ARITHMETIC EXPRESSION 03900023 ! 394: C RCOE01 =(.5 + .5 + .5) * 2. SO RCOE01 = 3. ELEMENT RCOE02 03910023 ! 395: C IS TESTED FOR THE VALUE 3. 03920023 ! 396: C 03930023 ! 397: IF (ICZERO) 36440, 6440, 36440 03940023 ! 398: 6440 CONTINUE 03950023 ! 399: RCOE02 = 0.5 03960023 ! 400: RCOE01 = ( RCOE01 + RCOE02 + RCOE03 ) * 2. 03970023 ! 401: IVCOMP = RCOE02 03980023 ! 402: GO TO 46440 03990023 ! 403: 36440 IVDELE = IVDELE + 1 04000023 ! 404: WRITE (I02,80003) IVTNUM 04010023 ! 405: IF (ICZERO) 46440, 6451, 46440 04020023 ! 406: 46440 IF ( IVCOMP - 3 ) 26440, 16440, 26440 04030023 ! 407: 16440 IVPASS = IVPASS + 1 04040023 ! 408: WRITE (I02,80001) IVTNUM 04050023 ! 409: GO TO 6451 04060023 ! 410: 26440 IVFAIL = IVFAIL + 1 04070023 ! 411: IVCORR = 3 04080023 ! 412: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04090023 ! 413: 6451 CONTINUE 04100023 ! 414: C 04110023 ! 415: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 04120023 ! 416: 99999 CONTINUE 04130023 ! 417: WRITE (I02,90002) 04140023 ! 418: WRITE (I02,90006) 04150023 ! 419: WRITE (I02,90002) 04160023 ! 420: WRITE (I02,90002) 04170023 ! 421: WRITE (I02,90007) 04180023 ! 422: WRITE (I02,90002) 04190023 ! 423: WRITE (I02,90008) IVFAIL 04200023 ! 424: WRITE (I02,90009) IVPASS 04210023 ! 425: WRITE (I02,90010) IVDELE 04220023 ! 426: C 04230023 ! 427: C 04240023 ! 428: C TERMINATE ROUTINE EXECUTION 04250023 ! 429: STOP 04260023 ! 430: C 04270023 ! 431: C FORMAT STATEMENTS FOR PAGE HEADERS 04280023 ! 432: 90000 FORMAT (1H1) 04290023 ! 433: 90002 FORMAT (1H ) 04300023 ! 434: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04310023 ! 435: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 04320023 ! 436: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 04330023 ! 437: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 04340023 ! 438: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 04350023 ! 439: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 04360023 ! 440: C 04370023 ! 441: C FORMAT STATEMENTS FOR RUN SUMMARIES 04380023 ! 442: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 04390023 ! 443: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 04400023 ! 444: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 04410023 ! 445: C 04420023 ! 446: C FORMAT STATEMENTS FOR TEST RESULTS 04430023 ! 447: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 04440023 ! 448: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 04450023 ! 449: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 04460023 ! 450: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 04470023 ! 451: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 04480023 ! 452: C 04490023 ! 453: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM023) 04500023 ! 454: END 04510023
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.