|
|
1.1 ! root 1: C 00010012 ! 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. 00020012 ! 6: C 00030012 ! 7: C FM012 00040012 ! 8: C 00050012 ! 9: C THIS ROUTINE TESTS THE FORTRAN DO - STATEMENT FROM ITS 00060012 ! 10: C SIMPLIST FORMAT TO THE MORE ABBREVIATED FORMS. VARIOUS INCREMENTS00070012 ! 11: C ARE USED AND BRANCHING BY VARIOUS METHODS IS TESTED FOR PASSING 00080012 ! 12: C CONTROL OUT OF THE DO RANGE AND RETURNING (EXTENDED RANGE). 00090012 ! 13: C NESTED DO STATEMENTS USING VARIOUS TERMINATING STATEMENTS ARE ALSO00100012 ! 14: C TESTED BY THIS ROUTINE. 00110012 ! 15: C 00120012 ! 16: C REFERENCES 00130012 ! 17: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140012 ! 18: C X3.9-1978 00150012 ! 19: C 00160012 ! 20: C SECTION 11.10, DO STATEMENT 00170012 ! 21: C SECTION 11.10.3, EXECUTES A DO LOOP 00180012 ! 22: C SECTION 11.11, CONTINUE STATEMENT 00190012 ! 23: C 00200012 ! 24: C 00210012 ! 25: C ********************************************************** 00220012 ! 26: C 00230012 ! 27: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00240012 ! 28: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00250012 ! 29: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00260012 ! 30: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00270012 ! 31: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00280012 ! 32: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00290012 ! 33: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00300012 ! 34: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00310012 ! 35: C OF EXECUTING THESE TESTS. 00320012 ! 36: C 00330012 ! 37: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00340012 ! 38: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00350012 ! 39: C 00360012 ! 40: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00370012 ! 41: C 00380012 ! 42: C DEPARTMENT OF THE NAVY 00390012 ! 43: C FEDERAL COBOL COMPILER TESTING SERVICE 00400012 ! 44: C WASHINGTON, D.C. 20376 00410012 ! 45: C 00420012 ! 46: C ********************************************************** 00430012 ! 47: C 00440012 ! 48: C 00450012 ! 49: C 00460012 ! 50: C INITIALIZATION SECTION 00470012 ! 51: C 00480012 ! 52: C INITIALIZE CONSTANTS 00490012 ! 53: C ************** 00500012 ! 54: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00510012 ! 55: I01 = 5 00520012 ! 56: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00530012 ! 57: I02 = 6 00540012 ! 58: C SYSTEM ENVIRONMENT SECTION 00550012 ! 59: C 00560012 ! 60: I01 = 5 00570012 ! 61: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00580012 ! 62: C (UNIT NUMBER FOR CARD READER). 00590012 ! 63: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00600012 ! 64: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00610012 ! 65: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00620012 ! 66: C 00630012 ! 67: I02 = 6 00640012 ! 68: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00650012 ! 69: C (UNIT NUMBER FOR PRINTER). 00660012 ! 70: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00670012 ! 71: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00680012 ! 72: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00690012 ! 73: C 00700012 ! 74: IVPASS=0 00710012 ! 75: IVFAIL=0 00720012 ! 76: IVDELE=0 00730012 ! 77: ICZERO=0 00740012 ! 78: C 00750012 ! 79: C WRITE PAGE HEADERS 00760012 ! 80: WRITE (I02,90000) 00770012 ! 81: WRITE (I02,90001) 00780012 ! 82: WRITE (I02,90002) 00790012 ! 83: WRITE (I02, 90002) 00800012 ! 84: WRITE (I02,90003) 00810012 ! 85: WRITE (I02,90002) 00820012 ! 86: WRITE (I02,90004) 00830012 ! 87: WRITE (I02,90002) 00840012 ! 88: WRITE (I02,90011) 00850012 ! 89: WRITE (I02,90002) 00860012 ! 90: WRITE (I02,90002) 00870012 ! 91: WRITE (I02,90005) 00880012 ! 92: WRITE (I02,90006) 00890012 ! 93: WRITE (I02,90002) 00900012 ! 94: IVTNUM = 110 00910012 ! 95: C 00920012 ! 96: C TEST 110 - DO STATEMENT WITH THE COMPLETE FORMAT, INCREMENT OF 100930012 ! 97: C THE LOOP SHOULD BE EXECUTED TEN (10) TIMES THUS THE LOOP 00940012 ! 98: C COUNTER SHOULD HAVE A VALUE OF TEN AT THE COMPLETION OF THE 00950012 ! 99: C DO-LOOP. 00960012 ! 100: C 00970012 ! 101: C 00980012 ! 102: IF (ICZERO) 31100, 1100, 31100 00990012 ! 103: 1100 CONTINUE 01000012 ! 104: IVON01=0 01010012 ! 105: DO 1102 I=1,10,1 01020012 ! 106: IVON01=IVON01+1 01030012 ! 107: 1102 CONTINUE 01040012 ! 108: GO TO 41100 01050012 ! 109: 31100 IVDELE = IVDELE + 1 01060012 ! 110: WRITE (I02,80003) IVTNUM 01070012 ! 111: IF (ICZERO) 41100, 1111, 41100 01080012 ! 112: 41100 IF(IVON01-10) 21100,11100,21100 01090012 ! 113: 11100 IVPASS = IVPASS + 1 01100012 ! 114: WRITE (I02,80001) IVTNUM 01110012 ! 115: GO TO 1111 01120012 ! 116: 21100 IVFAIL = IVFAIL + 1 01130012 ! 117: IVCOMP=IVON01 01140012 ! 118: IVCORR=10 01150012 ! 119: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01160012 ! 120: 1111 CONTINUE 01170012 ! 121: IVTNUM = 111 01180012 ! 122: C 01190012 ! 123: C TEST 111 - SAME DO TEST AS IN TEST 110 EXCEPT THAT NO INCREMENT 01200012 ! 124: C IS GIVEN. THE INCREMENT SHOULD BE 1 AND THE LOOP PERFORMED 01210012 ! 125: C TEN (10) TIMES AS BEFORE. 01220012 ! 126: C 01230012 ! 127: C 01240012 ! 128: IF (ICZERO) 31110, 1110, 31110 01250012 ! 129: 1110 CONTINUE 01260012 ! 130: IVON01=0 01270012 ! 131: DO 1112 J=1,10 01280012 ! 132: IVON01=IVON01+1 01290012 ! 133: 1112 CONTINUE 01300012 ! 134: GO TO 41110 01310012 ! 135: 31110 IVDELE = IVDELE + 1 01320012 ! 136: WRITE (I02,80003) IVTNUM 01330012 ! 137: IF (ICZERO) 41110, 1121, 41110 01340012 ! 138: 41110 IF(IVON01-10) 21110, 11110, 21110 01350012 ! 139: 11110 IVPASS = IVPASS + 1 01360012 ! 140: WRITE (I02,80001) IVTNUM 01370012 ! 141: GO TO 1121 01380012 ! 142: 21110 IVFAIL = IVFAIL + 1 01390012 ! 143: IVCOMP=IVON01 01400012 ! 144: IVCORR=10 01410012 ! 145: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01420012 ! 146: 1121 CONTINUE 01430012 ! 147: IVTNUM = 112 01440012 ! 148: C 01450012 ! 149: C TEST 112 - DO STATEMENT WITH AN INCREMENT OTHER THAN ONE (1). 01460012 ! 150: C THE DO - LOOP SHOULD BE EXECUTED FIVE (5) TIMES THUS 01470012 ! 151: C THE VALUE OF THE LOOP COUNTER SHOULD BE FIVE (5) AT THE 01480012 ! 152: C END OF THE DO - LOOP. 01490012 ! 153: C 01500012 ! 154: C 01510012 ! 155: IF (ICZERO) 31120, 1120, 31120 01520012 ! 156: 1120 CONTINUE 01530012 ! 157: IVON01=0 01540012 ! 158: DO 1122 K = 1, 10, 2 01550012 ! 159: IVON01=IVON01+1 01560012 ! 160: 1122 CONTINUE 01570012 ! 161: GO TO 41120 01580012 ! 162: 31120 IVDELE = IVDELE + 1 01590012 ! 163: WRITE (I02,80003) IVTNUM 01600012 ! 164: IF (ICZERO) 41120, 1131, 41120 01610012 ! 165: 41120 IF (IVON01 - 5 ) 21120, 11120, 21120 01620012 ! 166: 11120 IVPASS = IVPASS + 1 01630012 ! 167: WRITE (I02,80001) IVTNUM 01640012 ! 168: GO TO 1131 01650012 ! 169: 21120 IVFAIL = IVFAIL + 1 01660012 ! 170: IVCOMP=IVON01 01670012 ! 171: IVCORR=5 01680012 ! 172: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01690012 ! 173: 1131 CONTINUE 01700012 ! 174: IVTNUM = 113 01710012 ! 175: C 01720012 ! 176: C TEST 113 - DO STATEMENT WITH THE INITIAL VALUE EQUAL TO THE 01730012 ! 177: C TERMINAL VALUE. THE DO - LOOP SHOULD BE EXECUTED ONE (1) 01740012 ! 178: C TIME THUS THE VALUE OF THE LOOP COUNTER SHOULD BE ONE (1). 01750012 ! 179: C 01760012 ! 180: C 01770012 ! 181: IF (ICZERO) 31130, 1130, 31130 01780012 ! 182: 1130 CONTINUE 01790012 ! 183: IVON01=0 01800012 ! 184: DO 1132 L = 2, 2 01810012 ! 185: IVON01=IVON01+1 01820012 ! 186: 1132 CONTINUE 01830012 ! 187: GO TO 41130 01840012 ! 188: 31130 IVDELE = IVDELE + 1 01850012 ! 189: WRITE (I02,80003) IVTNUM 01860012 ! 190: IF (ICZERO) 41130, 1141, 41130 01870012 ! 191: 41130 IF ( IVON01 - 1 ) 21130, 11130, 21130 01880012 ! 192: 11130 IVPASS = IVPASS + 1 01890012 ! 193: WRITE (I02,80001) IVTNUM 01900012 ! 194: GO TO 1141 01910012 ! 195: 21130 IVFAIL = IVFAIL + 1 01920012 ! 196: IVCOMP=IVON01 01930012 ! 197: IVCORR=1 01940012 ! 198: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01950012 ! 199: 1141 CONTINUE 01960012 ! 200: IVTNUM = 114 01970012 ! 201: C 01980012 ! 202: C TEST 114 - THIS TESTS THE UNCONDITIONAL BRANCH OUT OF THE 01990012 ! 203: C RANGE OF THE DO USING THE GO TO STATEMENT. THE DO INDEX 02000012 ! 204: C SHOULD RETAIN THE VALUE IT HAD WHEN THE UNCONDITIONAL BRANCH02010012 ! 205: C WAS MADE. SINCE THE DO LOOP ONLY CONTAINS AN UNCONDITIONAL 02020012 ! 206: C BRANCH, THE VALUE OF THE DO INDEX SHOULD BE ITS INITIAL 02030012 ! 207: C VALUE. IN THIS CASE THE VALUE SHOULD BE ONE (1). 02040012 ! 208: C SEE SECTION 11.10. 02050012 ! 209: C 02060012 ! 210: C 02070012 ! 211: IF (ICZERO) 31140, 1140, 31140 02080012 ! 212: 1140 CONTINUE 02090012 ! 213: DO 1142 M=1,10 02100012 ! 214: GO TO 1143 02110012 ! 215: 1142 CONTINUE 02120012 ! 216: 1143 CONTINUE 02130012 ! 217: GO TO 41140 02140012 ! 218: 31140 IVDELE = IVDELE + 1 02150012 ! 219: WRITE (I02,80003) IVTNUM 02160012 ! 220: IF (ICZERO) 41140, 1151, 41140 02170012 ! 221: 41140 IF ( M - 1 ) 21140, 11140, 21140 02180012 ! 222: 11140 IVPASS = IVPASS + 1 02190012 ! 223: WRITE (I02,80001) IVTNUM 02200012 ! 224: GO TO 1151 02210012 ! 225: 21140 IVFAIL = IVFAIL + 1 02220012 ! 226: IVCOMP=M 02230012 ! 227: IVCORR=1 02240012 ! 228: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02250012 ! 229: 1151 CONTINUE 02260012 ! 230: IVTNUM = 115 02270012 ! 231: C 02280012 ! 232: C TEST 115 - THIS TEST IS SIMILAR TO TEST 114 IN THAT THE DO 02290012 ! 233: C RANGE HAS ONLY AN UNCONDITIONAL BRANCH OUTSIDE OF THE RANGE.02300012 ! 234: C THE DO INDEX SHOULD AGAIN RETAIN ITS VALUE, IN THIS CASE 02310012 ! 235: C ITS INITIAL VALUE OF ONE (1). 02320012 ! 236: C SEE SECTION 11.10. 02330012 ! 237: C 02340012 ! 238: C 02350012 ! 239: IF (ICZERO) 31150, 1150, 31150 02360012 ! 240: 1150 CONTINUE 02370012 ! 241: DO 1152 N = 1, 10 02380012 ! 242: IF ( N - 1 ) 1152, 1153, 1152 02390012 ! 243: 1152 CONTINUE 02400012 ! 244: 1153 CONTINUE 02410012 ! 245: GO TO 41150 02420012 ! 246: 31150 IVDELE = IVDELE + 1 02430012 ! 247: WRITE (I02,80003) IVTNUM 02440012 ! 248: IF (ICZERO) 41150, 1161, 41150 02450012 ! 249: 41150 IF (N - 1 ) 21150, 11150, 21150 02460012 ! 250: 11150 IVPASS = IVPASS + 1 02470012 ! 251: WRITE (I02,80001) IVTNUM 02480012 ! 252: GO TO 1161 02490012 ! 253: 21150 IVFAIL = IVFAIL + 1 02500012 ! 254: IVCOMP=N 02510012 ! 255: IVCORR=1 02520012 ! 256: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02530012 ! 257: 1161 CONTINUE 02540012 ! 258: IVTNUM = 116 02550012 ! 259: C 02560012 ! 260: C TEST 116 - THIS IS A TEST OF A NEST OF TWO DO RANGES. TWO 02570012 ! 261: C SEPARATE CONTINUE STATEMENTS ARE USED AS TERMINAL STATEMENTS02580012 ! 262: C FOR THE TWO RESPECTIVE DO RANGES. THE OUTER LOOP SHOULD BE 02590012 ! 263: C PERFORMED TEN (10) TIMES AND THE INNER LOOP SHOULD BE 02600012 ! 264: C PERFORMED TWICE FOR EACH EXECUTION OF THE OUTER LOOP. THE 02610012 ! 265: C LOOP COUNTER SHOULD HAVE A VALUE OF TWENTY (20) SINCE IT 02620012 ! 266: C IS INCREMENTED IN THE INNER DO - LOOP. 02630012 ! 267: C SEE SECTION 11.10.3. 02640012 ! 268: C 02650012 ! 269: C 02660012 ! 270: IF (ICZERO) 31160, 1160, 31160 02670012 ! 271: 1160 CONTINUE 02680012 ! 272: IVON01=0 02690012 ! 273: DO 1163 I=1,10,1 02700012 ! 274: DO 1162 J=1,2,1 02710012 ! 275: IVON01=IVON01+1 02720012 ! 276: 1162 CONTINUE 02730012 ! 277: 1163 CONTINUE 02740012 ! 278: GO TO 41160 02750012 ! 279: 31160 IVDELE = IVDELE + 1 02760012 ! 280: WRITE (I02,80003) IVTNUM 02770012 ! 281: IF (ICZERO) 41160, 1171, 41160 02780012 ! 282: 41160 IF ( IVON01 - 20 ) 21160, 11160, 21160 02790012 ! 283: 11160 IVPASS = IVPASS + 1 02800012 ! 284: WRITE (I02,80001) IVTNUM 02810012 ! 285: GO TO 1171 02820012 ! 286: 21160 IVFAIL = IVFAIL + 1 02830012 ! 287: IVCOMP=IVON01 02840012 ! 288: IVCORR=20 02850012 ! 289: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02860012 ! 290: 1171 CONTINUE 02870012 ! 291: IVTNUM = 117 02880012 ! 292: C 02890012 ! 293: C TEST 117 - THIS IS BASICALLY THE SAME AS TEST 116 EXCEPT THAT 02900012 ! 294: C ONLY ONE CONTINUE STATEMENT IS USED AS THE TERMINATING 02910012 ! 295: C STATEMENT FOR BOTH OF THE DO RANGES. THE VALUE OF THE 02920012 ! 296: C LOOP COUNTER SHOULD AGAIN BE TWENTY (20). 02930012 ! 297: C 02940012 ! 298: C 02950012 ! 299: IF (ICZERO) 31170, 1170, 31170 02960012 ! 300: 1170 CONTINUE 02970012 ! 301: IVON01=0 02980012 ! 302: DO 1172 K=1,10,1 02990012 ! 303: DO 1172 L=1,2,1 03000012 ! 304: IVON01=IVON01+1 03010012 ! 305: 1172 CONTINUE 03020012 ! 306: GO TO 41170 03030012 ! 307: 31170 IVDELE = IVDELE + 1 03040012 ! 308: WRITE (I02,80003) IVTNUM 03050012 ! 309: IF (ICZERO) 41170, 1181, 41170 03060012 ! 310: 41170 IF (IVON01 - 20 ) 21170, 11170, 21170 03070012 ! 311: 11170 IVPASS = IVPASS + 1 03080012 ! 312: WRITE (I02,80001) IVTNUM 03090012 ! 313: GO TO 1181 03100012 ! 314: 21170 IVFAIL = IVFAIL + 1 03110012 ! 315: IVCOMP=IVON01 03120012 ! 316: IVCORR=20 03130012 ! 317: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03140012 ! 318: 1181 CONTINUE 03150012 ! 319: IVTNUM = 118 03160012 ! 320: C 03170012 ! 321: C TEST 118 - THIS IS BASICALLY THE SAME TEST AS 116 EXCEPT 03180012 ! 322: C THAT THE LOOP COUNTER INCREMENT IS THE TERMINATING STATEMENT03190012 ! 323: C OF BOTH OF THE DO RANGES. THE VALUE OF THE LOOP COUNTER 03200012 ! 324: C SHOULD BE TWENTY (20), BUT THE NUMBER OF EXECUTIONS OF 03210012 ! 325: C THE OUTER LOOP IS NOW TWO (2) AND THE INNER LOOP EXECUTES 03220012 ! 326: C TEN (10) TIMES FOR EVERY EXECUTION OF THE OUTER LOOP. 03230012 ! 327: C 03240012 ! 328: C 03250012 ! 329: IF (ICZERO) 31180, 1180, 31180 03260012 ! 330: 1180 CONTINUE 03270012 ! 331: IVON01=0 03280012 ! 332: DO 1182 M=1,2,1 03290012 ! 333: DO 1182 N=1,10,1 03300012 ! 334: 1182 IVON01 = IVON01 + 1 03310012 ! 335: GO TO 41180 03320012 ! 336: 31180 IVDELE = IVDELE + 1 03330012 ! 337: WRITE (I02,80003) IVTNUM 03340012 ! 338: IF (ICZERO) 41180, 1191, 41180 03350012 ! 339: 41180 IF (IVON01 - 20 ) 21180, 11180, 21180 03360012 ! 340: 11180 IVPASS = IVPASS + 1 03370012 ! 341: WRITE (I02,80001) IVTNUM 03380012 ! 342: GO TO 1191 03390012 ! 343: 21180 IVFAIL = IVFAIL + 1 03400012 ! 344: IVCOMP=IVON01 03410012 ! 345: IVCORR=20 03420012 ! 346: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03430012 ! 347: 1191 CONTINUE 03440012 ! 348: IVTNUM = 119 03450012 ! 349: C 03460012 ! 350: C TEST 119 - THIS IS A TEST OF AN UNCONDITIONAL BRANCH OUT OF A 03470012 ! 351: C NESTED DO RANGE QUITE LIKE TEST 114. THE LOOP COUNTER 03480012 ! 352: C SHOULD ONLY BE INCREMENTED ON THE OUTER LOOP RANGE SO 03490012 ! 353: C THE FINAL VALUE OF THE LOOP COUNTER SHOULD BE TEN (10). 03500012 ! 354: C 03510012 ! 355: C 03520012 ! 356: IF (ICZERO) 31190, 1190, 31190 03530012 ! 357: 1190 CONTINUE 03540012 ! 358: IVON01=0 03550012 ! 359: DO 1194 I=1,10,1 03560012 ! 360: DO 1193 J=1,2,1 03570012 ! 361: C 03580012 ! 362: C THE FOLLOWING STATEMENT IS TO ELIMINATE THE DEAD CODE PRODUCED 03590012 ! 363: C BY THE STATEMENT GO TO 1194. 03600012 ! 364: C 03610012 ! 365: IF ( ICZERO ) 1193, 1192, 1193 03620012 ! 366: C 03630012 ! 367: 1192 GO TO 1194 03640012 ! 368: 1193 IVON01 = IVON01 + 1 03650012 ! 369: 1194 IVON01 = IVON01 + 1 03660012 ! 370: GO TO 41190 03670012 ! 371: 31190 IVDELE = IVDELE + 1 03680012 ! 372: WRITE (I02,80003) IVTNUM 03690012 ! 373: IF (ICZERO) 41190, 1201, 41190 03700012 ! 374: 41190 IF ( IVON01 - 10 ) 21190, 11190, 21190 03710012 ! 375: 11190 IVPASS = IVPASS + 1 03720012 ! 376: WRITE (I02,80001) IVTNUM 03730012 ! 377: GO TO 1201 03740012 ! 378: 21190 IVFAIL = IVFAIL + 1 03750012 ! 379: IVCOMP=IVON01 03760012 ! 380: IVCORR=10 03770012 ! 381: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03780012 ! 382: 1201 CONTINUE 03790012 ! 383: IVTNUM = 120 03800012 ! 384: C 03810012 ! 385: C TEST 120 - THIS IS BASICALLY THE SAME TEST AS TEST 119 EXCEPT 03820012 ! 386: C THAT AN IF STATEMENT IS USED TO BRANCH OUT OF THE INNER LOOP03830012 ! 387: C WITHOUT INCREMENTING THE LOOP COUNTER. THE VALUE OF THE 03840012 ! 388: C LOOP COUNTER SHOULD AGAIN BE TEN (10). 03850012 ! 389: C 03860012 ! 390: C 03870012 ! 391: IF (ICZERO) 31200, 1200, 31200 03880012 ! 392: 1200 CONTINUE 03890012 ! 393: IVON01=0 03900012 ! 394: DO 1203 I=1,10,1 03910012 ! 395: DO 1202 J=1,2,1 03920012 ! 396: IF ( J - 1 ) 1203, 1203, 1202 03930012 ! 397: 1202 IVON01 = IVON01 + 1 03940012 ! 398: 1203 IVON01 = IVON01 + 1 03950012 ! 399: GO TO 41200 03960012 ! 400: 31200 IVDELE = IVDELE + 1 03970012 ! 401: WRITE (I02,80003) IVTNUM 03980012 ! 402: IF (ICZERO) 41200, 1211, 41200 03990012 ! 403: 41200 IF ( IVON01 - 10 ) 21200, 11200, 21200 04000012 ! 404: 11200 IVPASS = IVPASS + 1 04010012 ! 405: WRITE (I02,80001) IVTNUM 04020012 ! 406: GO TO 1211 04030012 ! 407: 21200 IVFAIL = IVFAIL + 1 04040012 ! 408: IVCOMP=IVON01 04050012 ! 409: IVCORR=10 04060012 ! 410: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04070012 ! 411: 1211 CONTINUE 04080012 ! 412: IVTNUM = 121 04090012 ! 413: C 04100012 ! 414: C TEST 121 - THIS IS A TEST OF DO NESTS WITHIN DO NESTS. THE 04110012 ! 415: C LOOP COUNTER SHOULD HAVE A FINAL VALUE OF EIGHTY-FOUR (84). 04120012 ! 416: C 04130012 ! 417: C 04140012 ! 418: IF (ICZERO) 31210, 1210, 31210 04150012 ! 419: 1210 CONTINUE 04160012 ! 420: IVON01=0 04170012 ! 421: DO 1216 I1=1,2,1 04180012 ! 422: DO 1213 I2=1,3,1 04190012 ! 423: DO 1212 I3=1,4,1 04200012 ! 424: IVON01=IVON01+1 04210012 ! 425: 1212 CONTINUE 04220012 ! 426: 1213 CONTINUE 04230012 ! 427: DO 1215 I4=1,5,1 04240012 ! 428: DO 1214 I5=1,6,1 04250012 ! 429: IVON01=IVON01+1 04260012 ! 430: 1214 CONTINUE 04270012 ! 431: 1215 CONTINUE 04280012 ! 432: 1216 CONTINUE 04290012 ! 433: GO TO 41210 04300012 ! 434: 31210 IVDELE = IVDELE + 1 04310012 ! 435: WRITE (I02,80003) IVTNUM 04320012 ! 436: IF (ICZERO) 41210, 1221, 41210 04330012 ! 437: 41210 IF ( IVON01 - 84 ) 21210, 11210, 21210 04340012 ! 438: 11210 IVPASS = IVPASS + 1 04350012 ! 439: WRITE (I02,80001) IVTNUM 04360012 ! 440: GO TO 1221 04370012 ! 441: 21210 IVFAIL = IVFAIL + 1 04380012 ! 442: IVCOMP=IVON01 04390012 ! 443: IVCORR=84 04400012 ! 444: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04410012 ! 445: 1221 CONTINUE 04420012 ! 446: IVTNUM = 122 04430012 ! 447: C 04440012 ! 448: C TEST 122 - THIS IS AGAIN A TEST OF DO NESTS BUT COMBINED WITH 04450012 ! 449: C ARITHMETIC IF STATEMENT BRANCHES WITHIN THE DO RANGE. THE 04460012 ! 450: C FINAL LOOP COUNTER VALUE SHOULD BE EIGHTEEN (18). 04470012 ! 451: C 04480012 ! 452: C 04490012 ! 453: IF (ICZERO) 31220, 1220, 31220 04500012 ! 454: 1220 CONTINUE 04510012 ! 455: IVON01=0 04520012 ! 456: DO 1228 I1=1,3,1 04530012 ! 457: DO 1223 I2=1,4,1 04540012 ! 458: IF ( I2 - 3 ) 1222, 1224, 1224 04550012 ! 459: 1222 IVON01 = IVON01 + 1 04560012 ! 460: 1223 CONTINUE 04570012 ! 461: 1224 DO 1226 I3=1,5,1 04580012 ! 462: IF ( I3 - 3 ) 1225, 1225, 1227 04590012 ! 463: 1225 IVON01 = IVON01 + 1 04600012 ! 464: 1226 CONTINUE 04610012 ! 465: 1227 CONTINUE 04620012 ! 466: 1228 CONTINUE 04630012 ! 467: GO TO 41220 04640012 ! 468: 31220 IVDELE = IVDELE + 1 04650012 ! 469: WRITE (I02,80003) IVTNUM 04660012 ! 470: IF (ICZERO) 41220, 1231, 41220 04670012 ! 471: 41220 IF ( IVON01 - 15 ) 21220, 11220, 21220 04680012 ! 472: 11220 IVPASS = IVPASS + 1 04690012 ! 473: WRITE (I02,80001) IVTNUM 04700012 ! 474: GO TO 1231 04710012 ! 475: 21220 IVFAIL = IVFAIL + 1 04720012 ! 476: IVCOMP=IVON01 04730012 ! 477: IVCORR=15 04740012 ! 478: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04750012 ! 479: 1231 CONTINUE 04760012 ! 480: IVTNUM = 123 04770012 ! 481: C 04780012 ! 482: C NOTE **** TEST 123 WAS DELETED BY FCCTS. 04790012 ! 483: C 04800012 ! 484: IF (ICZERO) 31230, 1230, 31230 04810012 ! 485: 1230 CONTINUE 04820012 ! 486: 31230 IVDELE = IVDELE + 1 04830012 ! 487: WRITE (I02,80003) IVTNUM 04840012 ! 488: IF (ICZERO) 41230, 1241, 41230 04850012 ! 489: 41230 IF ( IVON01 - 20 ) 21230, 11230, 21230 04860012 ! 490: 11230 IVPASS = IVPASS + 1 04870012 ! 491: WRITE (I02,80001) IVTNUM 04880012 ! 492: GO TO 1241 04890012 ! 493: 21230 IVFAIL = IVFAIL + 1 04900012 ! 494: IVCOMP=IVON01 04910012 ! 495: IVCORR=20 04920012 ! 496: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04930012 ! 497: 1241 CONTINUE 04940012 ! 498: IVTNUM = 124 04950012 ! 499: C 04960012 ! 500: C TEST 124 - THIS IS A TEST OF A TRIPLE NESTED DO RANGE WITH 04970012 ! 501: C AN UNCONDITIONAL GO TO STATEMENT BRANCH IN THE INNERMOST 04980012 ! 502: C NESTED DO TO THE COMMON TERMINAL STATEMENT. THE FINAL 04990012 ! 503: C LOOP COUNTER VALUE SHOULD BE ONE HUNDRED AND FORTY-TWO (142)05000012 ! 504: C THE INITIAL VALUE OF THE INNERMOST DO RANGE IS TWO (2). 05010012 ! 505: C 05020012 ! 506: C 05030012 ! 507: IF (ICZERO) 31240, 1240, 31240 05040012 ! 508: 1240 CONTINUE 05050012 ! 509: IVON01=0 05060012 ! 510: DO 1242 I2=1,5,1 05070012 ! 511: DO 1242 I3=2,8,1 05080012 ! 512: DO 1242 I1=1,4,1 05090012 ! 513: IVON01=IVON01+1 05100012 ! 514: GO TO 1242 05110012 ! 515: 1242 CONTINUE 05120012 ! 516: GO TO 41240 05130012 ! 517: 31240 IVDELE = IVDELE + 1 05140012 ! 518: WRITE (I02,80003) IVTNUM 05150012 ! 519: IF (ICZERO) 41240, 1251, 41240 05160012 ! 520: 41240 IF ( IVON01 - 140 ) 21240, 11240, 21240 05170012 ! 521: 11240 IVPASS = IVPASS + 1 05180012 ! 522: WRITE (I02,80001) IVTNUM 05190012 ! 523: GO TO 1251 05200012 ! 524: 21240 IVFAIL = IVFAIL + 1 05210012 ! 525: IVCOMP=IVON01 05220012 ! 526: IVCORR=140 05230012 ! 527: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05240012 ! 528: 1251 CONTINUE 05250012 ! 529: IVTNUM = 125 05260012 ! 530: C 05270012 ! 531: C TEST 125 - THIS IS BASICALLY THE SAME AS TEST 124 EXCEPT THAT 05280012 ! 532: C AN ARITHMETIC IF BRANCH IS USED INSTEAD OF THE GO TO 05290012 ! 533: C STATEMENT FOR THE BRANCH TO THE TERMINAL STATEMENT COMMON 05300012 ! 534: C TO ALL THREE OF THE DO RANGES. 05310012 ! 535: C THE FINAL VALUE OF THE LOOP COUNTER SHOULD BE ONE 05320012 ! 536: C HUNDRED AND FORTY (140). 05330012 ! 537: C 05340012 ! 538: C 05350012 ! 539: IF (ICZERO) 31250, 1250, 31250 05360012 ! 540: 1250 CONTINUE 05370012 ! 541: IVON01=0 05380012 ! 542: DO 1252 I1=1,4,1 05390012 ! 543: DO 1252 I2=1,5,1 05400012 ! 544: DO 1252 I3=2,8,1 05410012 ! 545: IVON01=IVON01+1 05420012 ! 546: IF ( I3 - 9 ) 1252, 1252, 1253 05430012 ! 547: 1252 CONTINUE 05440012 ! 548: 1253 CONTINUE 05450012 ! 549: GO TO 41250 05460012 ! 550: 31250 IVDELE = IVDELE + 1 05470012 ! 551: WRITE (I02,80003) IVTNUM 05480012 ! 552: IF (ICZERO) 41250, 1261, 41250 05490012 ! 553: 41250 IF ( IVON01 - 140 ) 21250, 11250, 21250 05500012 ! 554: 11250 IVPASS = IVPASS + 1 05510012 ! 555: WRITE (I02,80001) IVTNUM 05520012 ! 556: GO TO 1261 05530012 ! 557: 21250 IVFAIL = IVFAIL + 1 05540012 ! 558: IVCOMP=IVON01 05550012 ! 559: IVCORR=140 05560012 ! 560: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05570012 ! 561: 1261 CONTINUE 05580012 ! 562: C 05590012 ! 563: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 05600012 ! 564: 99999 CONTINUE 05610012 ! 565: WRITE (I02,90002) 05620012 ! 566: WRITE (I02,90006) 05630012 ! 567: WRITE (I02,90002) 05640012 ! 568: WRITE (I02,90002) 05650012 ! 569: WRITE (I02,90007) 05660012 ! 570: WRITE (I02,90002) 05670012 ! 571: WRITE (I02,90008) IVFAIL 05680012 ! 572: WRITE (I02,90009) IVPASS 05690012 ! 573: WRITE (I02,90010) IVDELE 05700012 ! 574: C 05710012 ! 575: C 05720012 ! 576: C TERMINATE ROUTINE EXECUTION 05730012 ! 577: STOP 05740012 ! 578: C 05750012 ! 579: C FORMAT STATEMENTS FOR PAGE HEADERS 05760012 ! 580: 90000 FORMAT (1H1) 05770012 ! 581: 90002 FORMAT (1H ) 05780012 ! 582: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 05790012 ! 583: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 05800012 ! 584: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 05810012 ! 585: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 05820012 ! 586: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 05830012 ! 587: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 05840012 ! 588: C 05850012 ! 589: C FORMAT STATEMENTS FOR RUN SUMMARIES 05860012 ! 590: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 05870012 ! 591: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 05880012 ! 592: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 05890012 ! 593: C 05900012 ! 594: C FORMAT STATEMENTS FOR TEST RESULTS 05910012 ! 595: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 05920012 ! 596: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 05930012 ! 597: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 05940012 ! 598: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 05950012 ! 599: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 05960012 ! 600: C 05970012 ! 601: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM012) 05980012 ! 602: END 05990012
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.