|
|
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.