![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm012.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests|
Return to fm012.f CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests |
1.1 root 1: c
2: c comment section.
3: c
4: c fm012
5: c
6: c this routine tests the fortran do - statement from its
7: c simplist format to the more abbreviated forms. various increments
8: c are used and branching by various methods is tested for passing
9: c control out of the do range and returning (extended range).
10: c nested do statements using various terminating statements are also
11: c tested by this routine.
12: c
13: c references
14: c american national standard programming language fortran,
15: c x3.9-1978
16: c
17: c section 11.10, do statement
18: c section 11.10.3, executes a do loop
19: c section 11.11, continue statement
20: c
21: c
22: c **********************************************************
23: c
24: c a compiler validation system for the fortran language
25: c based on specifications as defined in american national standard
26: c programming language fortran x3.9-1978, has been developed by the
27: c federal cobol compiler testing service. the fortran compiler
28: c validation system (fcvs) consists of audit routines, their related
29: c data, and an executive system. each audit routine is a fortran
30: c program, subprogram or function which includes tests of specific
31: c language elements and supporting procedures indicating the result
32: c of executing these tests.
33: c
34: c this particular program/subprogram/function contains features
35: c found only in the subset as defined in x3.9-1978.
36: c
37: c suggestions and comments should be forwarded to -
38: c
39: c department of the navy
40: c federal cobol compiler testing service
41: c washington, d.c. 20376
42: c
43: c **********************************************************
44: c
45: c
46: c
47: c initialization section
48: c
49: c initialize constants
50: c **************
51: c i01 contains the logical unit number for the card reader.
52: i01 = 5
53: c i02 contains the logical unit number for the printer.
54: i02 = 6
55: c system environment section
56: c
57: cx010 this card is replaced by contents of fexec x-010 control card.
58: c the cx010 card is for overriding the program default i01 = 5
59: c (unit number for card reader).
60: cx011 this card is replaced by contents of fexec x-011 control card.
61: c the cx011 card is for systems which require additional
62: c fortran statements for files associated with cx010 above.
63: c
64: cx020 this card is replaced by contents of fexec x-020 control card.
65: c the cx020 card is for overriding the program default i02 = 6
66: c (unit number for printer).
67: cx021 this card is replaced by contents of fexec x-021 control card.
68: c the cx021 card is for systems which require additional
69: c fortran statements for files associated with cx020 above.
70: c
71: ivpass=0
72: ivfail=0
73: ivdele=0
74: iczero=0
75: c
76: c write page headers
77: write (i02,90000)
78: write (i02,90001)
79: write (i02,90002)
80: write (i02, 90002)
81: write (i02,90003)
82: write (i02,90002)
83: write (i02,90004)
84: write (i02,90002)
85: write (i02,90011)
86: write (i02,90002)
87: write (i02,90002)
88: write (i02,90005)
89: write (i02,90006)
90: write (i02,90002)
91: ivtnum = 110
92: c
93: c test 110 - do statement with the complete format, increment of 1
94: c the loop should be executed ten (10) times thus the loop
95: c counter should have a value of ten at the completion of the
96: c do-loop.
97: c
98: c
99: if (iczero) 31100, 1100, 31100
100: 1100 continue
101: ivon01=0
102: do 1102 i=1,10,1
103: ivon01=ivon01+1
104: 1102 continue
105: go to 41100
106: 31100 ivdele = ivdele + 1
107: write (i02,80003) ivtnum
108: if (iczero) 41100, 1111, 41100
109: 41100 if(ivon01-10) 21100,11100,21100
110: 11100 ivpass = ivpass + 1
111: write (i02,80001) ivtnum
112: go to 1111
113: 21100 ivfail = ivfail + 1
114: ivcomp=ivon01
115: ivcorr=10
116: write (i02,80004) ivtnum, ivcomp ,ivcorr
117: 1111 continue
118: ivtnum = 111
119: c
120: c test 111 - same do test as in test 110 except that no increment
121: c is given. the increment should be 1 and the loop performed
122: c ten (10) times as before.
123: c
124: c
125: if (iczero) 31110, 1110, 31110
126: 1110 continue
127: ivon01=0
128: do 1112 j=1,10
129: ivon01=ivon01+1
130: 1112 continue
131: go to 41110
132: 31110 ivdele = ivdele + 1
133: write (i02,80003) ivtnum
134: if (iczero) 41110, 1121, 41110
135: 41110 if(ivon01-10) 21110, 11110, 21110
136: 11110 ivpass = ivpass + 1
137: write (i02,80001) ivtnum
138: go to 1121
139: 21110 ivfail = ivfail + 1
140: ivcomp=ivon01
141: ivcorr=10
142: write (i02,80004) ivtnum, ivcomp ,ivcorr
143: 1121 continue
144: ivtnum = 112
145: c
146: c test 112 - do statement with an increment other than one (1).
147: c the do - loop should be executed five (5) times thus
148: c the value of the loop counter should be five (5) at the
149: c end of the do - loop.
150: c
151: c
152: if (iczero) 31120, 1120, 31120
153: 1120 continue
154: ivon01=0
155: do 1122 k = 1, 10, 2
156: ivon01=ivon01+1
157: 1122 continue
158: go to 41120
159: 31120 ivdele = ivdele + 1
160: write (i02,80003) ivtnum
161: if (iczero) 41120, 1131, 41120
162: 41120 if (ivon01 - 5 ) 21120, 11120, 21120
163: 11120 ivpass = ivpass + 1
164: write (i02,80001) ivtnum
165: go to 1131
166: 21120 ivfail = ivfail + 1
167: ivcomp=ivon01
168: ivcorr=5
169: write (i02,80004) ivtnum, ivcomp ,ivcorr
170: 1131 continue
171: ivtnum = 113
172: c
173: c test 113 - do statement with the initial value equal to the
174: c terminal value. the do - loop should be executed one (1)
175: c time thus the value of the loop counter should be one (1).
176: c
177: c
178: if (iczero) 31130, 1130, 31130
179: 1130 continue
180: ivon01=0
181: do 1132 l = 2, 2
182: ivon01=ivon01+1
183: 1132 continue
184: go to 41130
185: 31130 ivdele = ivdele + 1
186: write (i02,80003) ivtnum
187: if (iczero) 41130, 1141, 41130
188: 41130 if ( ivon01 - 1 ) 21130, 11130, 21130
189: 11130 ivpass = ivpass + 1
190: write (i02,80001) ivtnum
191: go to 1141
192: 21130 ivfail = ivfail + 1
193: ivcomp=ivon01
194: ivcorr=1
195: write (i02,80004) ivtnum, ivcomp ,ivcorr
196: 1141 continue
197: ivtnum = 114
198: c
199: c test 114 - this tests the unconditional branch out of the
200: c range of the do using the go to statement. the do index
201: c should retain the value it had when the unconditional branch
202: c was made. since the do loop only contains an unconditional
203: c branch, the value of the do index should be its initial
204: c value. in this case the value should be one (1).
205: c see section 11.10.
206: c
207: c
208: if (iczero) 31140, 1140, 31140
209: 1140 continue
210: do 1142 m=1,10
211: go to 1143
212: 1142 continue
213: 1143 continue
214: go to 41140
215: 31140 ivdele = ivdele + 1
216: write (i02,80003) ivtnum
217: if (iczero) 41140, 1151, 41140
218: 41140 if ( m - 1 ) 21140, 11140, 21140
219: 11140 ivpass = ivpass + 1
220: write (i02,80001) ivtnum
221: go to 1151
222: 21140 ivfail = ivfail + 1
223: ivcomp=m
224: ivcorr=1
225: write (i02,80004) ivtnum, ivcomp ,ivcorr
226: 1151 continue
227: ivtnum = 115
228: c
229: c test 115 - this test is similar to test 114 in that the do
230: c range has only an unconditional branch outside of the range.
231: c the do index should again retain its value, in this case
232: c its initial value of one (1).
233: c see section 11.10.
234: c
235: c
236: if (iczero) 31150, 1150, 31150
237: 1150 continue
238: do 1152 n = 1, 10
239: if ( n - 1 ) 1152, 1153, 1152
240: 1152 continue
241: 1153 continue
242: go to 41150
243: 31150 ivdele = ivdele + 1
244: write (i02,80003) ivtnum
245: if (iczero) 41150, 1161, 41150
246: 41150 if (n - 1 ) 21150, 11150, 21150
247: 11150 ivpass = ivpass + 1
248: write (i02,80001) ivtnum
249: go to 1161
250: 21150 ivfail = ivfail + 1
251: ivcomp=n
252: ivcorr=1
253: write (i02,80004) ivtnum, ivcomp ,ivcorr
254: 1161 continue
255: ivtnum = 116
256: c
257: c test 116 - this is a test of a nest of two do ranges. two
258: c separate continue statements are used as terminal statements
259: c for the two respective do ranges. the outer loop should be
260: c performed ten (10) times and the inner loop should be
261: c performed twice for each execution of the outer loop. the
262: c loop counter should have a value of twenty (20) since it
263: c is incremented in the inner do - loop.
264: c see section 11.10.3.
265: c
266: c
267: if (iczero) 31160, 1160, 31160
268: 1160 continue
269: ivon01=0
270: do 1163 i=1,10,1
271: do 1162 j=1,2,1
272: ivon01=ivon01+1
273: 1162 continue
274: 1163 continue
275: go to 41160
276: 31160 ivdele = ivdele + 1
277: write (i02,80003) ivtnum
278: if (iczero) 41160, 1171, 41160
279: 41160 if ( ivon01 - 20 ) 21160, 11160, 21160
280: 11160 ivpass = ivpass + 1
281: write (i02,80001) ivtnum
282: go to 1171
283: 21160 ivfail = ivfail + 1
284: ivcomp=ivon01
285: ivcorr=20
286: write (i02,80004) ivtnum, ivcomp ,ivcorr
287: 1171 continue
288: ivtnum = 117
289: c
290: c test 117 - this is basically the same as test 116 except that
291: c only one continue statement is used as the terminating
292: c statement for both of the do ranges. the value of the
293: c loop counter should again be twenty (20).
294: c
295: c
296: if (iczero) 31170, 1170, 31170
297: 1170 continue
298: ivon01=0
299: do 1172 k=1,10,1
300: do 1172 l=1,2,1
301: ivon01=ivon01+1
302: 1172 continue
303: go to 41170
304: 31170 ivdele = ivdele + 1
305: write (i02,80003) ivtnum
306: if (iczero) 41170, 1181, 41170
307: 41170 if (ivon01 - 20 ) 21170, 11170, 21170
308: 11170 ivpass = ivpass + 1
309: write (i02,80001) ivtnum
310: go to 1181
311: 21170 ivfail = ivfail + 1
312: ivcomp=ivon01
313: ivcorr=20
314: write (i02,80004) ivtnum, ivcomp ,ivcorr
315: 1181 continue
316: ivtnum = 118
317: c
318: c test 118 - this is basically the same test as 116 except
319: c that the loop counter increment is the terminating statement
320: c of both of the do ranges. the value of the loop counter
321: c should be twenty (20), but the number of executions of
322: c the outer loop is now two (2) and the inner loop executes
323: c ten (10) times for every execution of the outer loop.
324: c
325: c
326: if (iczero) 31180, 1180, 31180
327: 1180 continue
328: ivon01=0
329: do 1182 m=1,2,1
330: do 1182 n=1,10,1
331: 1182 ivon01 = ivon01 + 1
332: go to 41180
333: 31180 ivdele = ivdele + 1
334: write (i02,80003) ivtnum
335: if (iczero) 41180, 1191, 41180
336: 41180 if (ivon01 - 20 ) 21180, 11180, 21180
337: 11180 ivpass = ivpass + 1
338: write (i02,80001) ivtnum
339: go to 1191
340: 21180 ivfail = ivfail + 1
341: ivcomp=ivon01
342: ivcorr=20
343: write (i02,80004) ivtnum, ivcomp ,ivcorr
344: 1191 continue
345: ivtnum = 119
346: c
347: c test 119 - this is a test of an unconditional branch out of a
348: c nested do range quite like test 114. the loop counter
349: c should only be incremented on the outer loop range so
350: c the final value of the loop counter should be ten (10).
351: c
352: c
353: if (iczero) 31190, 1190, 31190
354: 1190 continue
355: ivon01=0
356: do 1194 i=1,10,1
357: do 1193 j=1,2,1
358: c
359: c the following statement is to eliminate the dead code produced
360: c by the statement go to 1194.
361: c
362: if ( iczero ) 1193, 1192, 1193
363: c
364: 1192 go to 1194
365: 1193 ivon01 = ivon01 + 1
366: 1194 ivon01 = ivon01 + 1
367: go to 41190
368: 31190 ivdele = ivdele + 1
369: write (i02,80003) ivtnum
370: if (iczero) 41190, 1201, 41190
371: 41190 if ( ivon01 - 10 ) 21190, 11190, 21190
372: 11190 ivpass = ivpass + 1
373: write (i02,80001) ivtnum
374: go to 1201
375: 21190 ivfail = ivfail + 1
376: ivcomp=ivon01
377: ivcorr=10
378: write (i02,80004) ivtnum, ivcomp ,ivcorr
379: 1201 continue
380: ivtnum = 120
381: c
382: c test 120 - this is basically the same test as test 119 except
383: c that an if statement is used to branch out of the inner loop
384: c without incrementing the loop counter. the value of the
385: c loop counter should again be ten (10).
386: c
387: c
388: if (iczero) 31200, 1200, 31200
389: 1200 continue
390: ivon01=0
391: do 1203 i=1,10,1
392: do 1202 j=1,2,1
393: if ( j - 1 ) 1203, 1203, 1202
394: 1202 ivon01 = ivon01 + 1
395: 1203 ivon01 = ivon01 + 1
396: go to 41200
397: 31200 ivdele = ivdele + 1
398: write (i02,80003) ivtnum
399: if (iczero) 41200, 1211, 41200
400: 41200 if ( ivon01 - 10 ) 21200, 11200, 21200
401: 11200 ivpass = ivpass + 1
402: write (i02,80001) ivtnum
403: go to 1211
404: 21200 ivfail = ivfail + 1
405: ivcomp=ivon01
406: ivcorr=10
407: write (i02,80004) ivtnum, ivcomp ,ivcorr
408: 1211 continue
409: ivtnum = 121
410: c
411: c test 121 - this is a test of do nests within do nests. the
412: c loop counter should have a final value of eighty-four (84).
413: c
414: c
415: if (iczero) 31210, 1210, 31210
416: 1210 continue
417: ivon01=0
418: do 1216 i1=1,2,1
419: do 1213 i2=1,3,1
420: do 1212 i3=1,4,1
421: ivon01=ivon01+1
422: 1212 continue
423: 1213 continue
424: do 1215 i4=1,5,1
425: do 1214 i5=1,6,1
426: ivon01=ivon01+1
427: 1214 continue
428: 1215 continue
429: 1216 continue
430: go to 41210
431: 31210 ivdele = ivdele + 1
432: write (i02,80003) ivtnum
433: if (iczero) 41210, 1221, 41210
434: 41210 if ( ivon01 - 84 ) 21210, 11210, 21210
435: 11210 ivpass = ivpass + 1
436: write (i02,80001) ivtnum
437: go to 1221
438: 21210 ivfail = ivfail + 1
439: ivcomp=ivon01
440: ivcorr=84
441: write (i02,80004) ivtnum, ivcomp ,ivcorr
442: 1221 continue
443: ivtnum = 122
444: c
445: c test 122 - this is again a test of do nests but combined with
446: c arithmetic if statement branches within the do range. the
447: c final loop counter value should be eighteen (18).
448: c
449: c
450: if (iczero) 31220, 1220, 31220
451: 1220 continue
452: ivon01=0
453: do 1228 i1=1,3,1
454: do 1223 i2=1,4,1
455: if ( i2 - 3 ) 1222, 1224, 1224
456: 1222 ivon01 = ivon01 + 1
457: 1223 continue
458: 1224 do 1226 i3=1,5,1
459: if ( i3 - 3 ) 1225, 1225, 1227
460: 1225 ivon01 = ivon01 + 1
461: 1226 continue
462: 1227 continue
463: 1228 continue
464: go to 41220
465: 31220 ivdele = ivdele + 1
466: write (i02,80003) ivtnum
467: if (iczero) 41220, 1231, 41220
468: 41220 if ( ivon01 - 15 ) 21220, 11220, 21220
469: 11220 ivpass = ivpass + 1
470: write (i02,80001) ivtnum
471: go to 1231
472: 21220 ivfail = ivfail + 1
473: ivcomp=ivon01
474: ivcorr=15
475: write (i02,80004) ivtnum, ivcomp ,ivcorr
476: 1231 continue
477: ivtnum = 123
478: c
479: c note **** test 123 was deleted by fccts.
480: c
481: if (iczero) 31230, 1230, 31230
482: 1230 continue
483: 31230 ivdele = ivdele + 1
484: write (i02,80003) ivtnum
485: if (iczero) 41230, 1241, 41230
486: 41230 if ( ivon01 - 20 ) 21230, 11230, 21230
487: 11230 ivpass = ivpass + 1
488: write (i02,80001) ivtnum
489: go to 1241
490: 21230 ivfail = ivfail + 1
491: ivcomp=ivon01
492: ivcorr=20
493: write (i02,80004) ivtnum, ivcomp ,ivcorr
494: 1241 continue
495: ivtnum = 124
496: c
497: c test 124 - this is a test of a triple nested do range with
498: c an unconditional go to statement branch in the innermost
499: c nested do to the common terminal statement. the final
500: c loop counter value should be one hundred and forty-two (142)
501: c the initial value of the innermost do range is two (2).
502: c
503: c
504: if (iczero) 31240, 1240, 31240
505: 1240 continue
506: ivon01=0
507: do 1242 i2=1,5,1
508: do 1242 i3=2,8,1
509: do 1242 i1=1,4,1
510: ivon01=ivon01+1
511: go to 1242
512: 1242 continue
513: go to 41240
514: 31240 ivdele = ivdele + 1
515: write (i02,80003) ivtnum
516: if (iczero) 41240, 1251, 41240
517: 41240 if ( ivon01 - 140 ) 21240, 11240, 21240
518: 11240 ivpass = ivpass + 1
519: write (i02,80001) ivtnum
520: go to 1251
521: 21240 ivfail = ivfail + 1
522: ivcomp=ivon01
523: ivcorr=140
524: write (i02,80004) ivtnum, ivcomp ,ivcorr
525: 1251 continue
526: ivtnum = 125
527: c
528: c test 125 - this is basically the same as test 124 except that
529: c an arithmetic if branch is used instead of the go to
530: c statement for the branch to the terminal statement common
531: c to all three of the do ranges.
532: c the final value of the loop counter should be one
533: c hundred and forty (140).
534: c
535: c
536: if (iczero) 31250, 1250, 31250
537: 1250 continue
538: ivon01=0
539: do 1252 i1=1,4,1
540: do 1252 i2=1,5,1
541: do 1252 i3=2,8,1
542: ivon01=ivon01+1
543: if ( i3 - 9 ) 1252, 1252, 1253
544: 1252 continue
545: 1253 continue
546: go to 41250
547: 31250 ivdele = ivdele + 1
548: write (i02,80003) ivtnum
549: if (iczero) 41250, 1261, 41250
550: 41250 if ( ivon01 - 140 ) 21250, 11250, 21250
551: 11250 ivpass = ivpass + 1
552: write (i02,80001) ivtnum
553: go to 1261
554: 21250 ivfail = ivfail + 1
555: ivcomp=ivon01
556: ivcorr=140
557: write (i02,80004) ivtnum, ivcomp ,ivcorr
558: 1261 continue
559: c
560: c write page footings and run summaries
561: 99999 continue
562: write (i02,90002)
563: write (i02,90006)
564: write (i02,90002)
565: write (i02,90002)
566: write (i02,90007)
567: write (i02,90002)
568: write (i02,90008) ivfail
569: write (i02,90009) ivpass
570: write (i02,90010) ivdele
571: c
572: c
573: c terminate routine execution
574: stop
575: c
576: c format statements for page headers
577: 90000 format (1h1)
578: 90002 format (1h )
579: 90001 format (1h ,10x,34hfortran compiler validation system)
580: 90003 format (1h ,21x,11hversion 1.0)
581: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
582: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
583: 90006 format (1h ,5x,46h----------------------------------------------)
584: 90011 format (1h ,18x,17hsubset level test)
585: c
586: c format statements for run summaries
587: 90008 format (1h ,15x,i5,19h errors encountered)
588: 90009 format (1h ,15x,i5,13h tests passed)
589: 90010 format (1h ,15x,i5,14h tests deleted)
590: c
591: c format statements for test results
592: 80001 format (1h ,4x,i5,7x,4hpass)
593: 80002 format (1h ,4x,i5,7x,4hfail)
594: 80003 format (1h ,4x,i5,7x,7hdeleted)
595: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
596: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
597: c
598: 90007 format (1h ,20x,20hend of program fm012)
599: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.