![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm050.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 fm050.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 fm050
5: c
6: c this routine contains basic subroutine and function reference
7: c tests. four subroutines and one function are called or
8: c referenced. fs051 is called to test the calling and passing of
9: c arguments through unlabeled common. no arguments are specified
10: c in the call line. fs052 is identical to fs051 except that several
11: c returns are used. fs053 utilizes many arguments on the call
12: c statement and many return statements in the subroutine body.
13: c ff054 is a function subroutine in which many arguments and return
14: c statements are used. and finally fs055 passes a one dimenional
15: c array back to fm050.
16: c
17: c references
18: c american national standard programming language fortran,
19: c x3.9-1978
20: c
21: c section 15.5.2, referencing an external function
22: c section 15.6.2, subroutine reference
23: c
24: common rvcn01,ivcn01,ivcn02,iacn11(20)
25: integer ff054
26: c
27: c **********************************************************
28: c
29: c a compiler validation system for the fortran language
30: c based on specifications as defined in american national standard
31: c programming language fortran x3.9-1978, has been developed by the
32: c federal cobol compiler testing service. the fortran compiler
33: c validation system (fcvs) consists of audit routines, their related
34: c data, and an executive system. each audit routine is a fortran
35: c program, subprogram or function which includes tests of specific
36: c language elements and supporting procedures indicating the result
37: c of executing these tests.
38: c
39: c this particular program/subprogram/function contains features
40: c found only in the subset as defined in x3.9-1978.
41: c
42: c suggestions and comments should be forwarded to -
43: c
44: c department of the navy
45: c federal cobol compiler testing service
46: c washington, d.c. 20376
47: c
48: c **********************************************************
49: c
50: c
51: c
52: c initialization section
53: c
54: c initialize constants
55: c **************
56: c i01 contains the logical unit number for the card reader.
57: i01 = 5
58: c i02 contains the logical unit number for the printer.
59: i02 = 6
60: c system environment section
61: c
62: cx010 this card is replaced by contents of fexec x-010 control card.
63: c the cx010 card is for overriding the program default i01 = 5
64: c (unit number for card reader).
65: cx011 this card is replaced by contents of fexec x-011 control card.
66: c the cx011 card is for systems which require additional
67: c fortran statements for files associated with cx010 above.
68: c
69: cx020 this card is replaced by contents of fexec x-020 control card.
70: c the cx020 card is for overriding the program default i02 = 6
71: c (unit number for printer).
72: cx021 this card is replaced by contents of fexec x-021 control card.
73: c the cx021 card is for systems which require additional
74: c fortran statements for files associated with cx020 above.
75: c
76: ivpass=0
77: ivfail=0
78: ivdele=0
79: iczero=0
80: c
81: c write page headers
82: write (i02,90000)
83: write (i02,90001)
84: write (i02,90002)
85: write (i02, 90002)
86: write (i02,90003)
87: write (i02,90002)
88: write (i02,90004)
89: write (i02,90002)
90: write (i02,90011)
91: write (i02,90002)
92: write (i02,90002)
93: write (i02,90005)
94: write (i02,90006)
95: write (i02,90002)
96: c test section
97: c
98: c subroutine and function subprograms
99: c
100: 4001 continue
101: ivtnum = 400
102: c
103: c **** test 400 ****
104: c test 400 tests the call to a subroutine containing no arguments.
105: c all parameters are passed through unlabeled common.
106: c
107: if (iczero) 34000, 4000, 34000
108: 4000 continue
109: rvcn01 = 2.1654
110: call fs051
111: rvcomp = rvcn01
112: go to 44000
113: 34000 ivdele = ivdele + 1
114: write (i02,80003) ivtnum
115: if (iczero) 44000, 4011, 44000
116: 44000 if (rvcomp - 3.1649) 24000,14000,44001
117: 44001 if (rvcomp - 3.1659) 14000,14000,24000
118: 14000 ivpass = ivpass + 1
119: write (i02,80001) ivtnum
120: go to 4011
121: 24000 ivfail = ivfail + 1
122: rvcorr = 3.1654
123: write (i02,80005) ivtnum, rvcomp, rvcorr
124: 4011 continue
125: c
126: c test 401 through test 403 test the call to subroutine fs052 which
127: c contains no arguments. all parameters are passed through
128: c unlabeled common. subroutine fs052 contain several return
129: c statements.
130: c
131: ivtnum = 401
132: c
133: c **** test 401 ****
134: c
135: if (iczero) 34010, 4010, 34010
136: 4010 continue
137: ivcn01 = 5
138: ivcn02 = 1
139: call fs052
140: ivcomp = ivcn01
141: go to 44010
142: 34010 ivdele = ivdele + 1
143: write (i02,80003) ivtnum
144: if (iczero) 44010, 4021, 44010
145: 44010 if (ivcomp - 6) 24010,14010,24010
146: 14010 ivpass = ivpass + 1
147: write (i02,80001) ivtnum
148: go to 4021
149: 24010 ivfail = ivfail + 1
150: ivcorr = 6
151: write (i02,80004) ivtnum, ivcomp ,ivcorr
152: 4021 continue
153: ivtnum = 402
154: c
155: c **** test 402 ****
156: c
157: if (iczero) 34020, 4020, 34020
158: 4020 continue
159: ivcn01 = 10
160: ivcn02 = 5
161: call fs052
162: ivcomp = ivcn01
163: go to 44020
164: 34020 ivdele = ivdele + 1
165: write (i02,80003) ivtnum
166: if (iczero) 44020, 4031, 44020
167: 44020 if (ivcomp - 15) 24020,14020,24020
168: 14020 ivpass = ivpass + 1
169: write (i02,80001) ivtnum
170: go to 4031
171: 24020 ivfail = ivfail + 1
172: ivcorr = 15
173: write (i02,80004) ivtnum, ivcomp ,ivcorr
174: 4031 continue
175: ivtnum = 403
176: c
177: c **** test 403 ****
178: c
179: if (iczero) 34030, 4030, 34030
180: 4030 continue
181: ivcn01 = 30
182: ivcn02 = 3
183: call fs052
184: ivcomp = ivcn01
185: go to 44030
186: 34030 ivdele = ivdele + 1
187: write (i02,80003) ivtnum
188: if (iczero) 44030, 4041, 44030
189: 44030 if (ivcomp - 33) 24030,14030,24030
190: 14030 ivpass = ivpass + 1
191: write (i02,80001) ivtnum
192: go to 4041
193: 24030 ivfail = ivfail + 1
194: ivcorr = 33
195: write (i02,80004) ivtnum, ivcomp ,ivcorr
196: 4041 continue
197: c
198: c test 404 through test 406 test the call to subroutine fs053 which
199: c contains several arguments and several return statements.
200: c
201: ivtnum = 404
202: c
203: c **** test 404 ****
204: c
205: if (iczero) 34040, 4040, 34040
206: 4040 continue
207: call fs053 (6,10,11,ivon04,1)
208: ivcomp = ivon04
209: go to 44040
210: 34040 ivdele = ivdele + 1
211: write (i02,80003) ivtnum
212: if (iczero) 44040, 4051, 44040
213: 44040 if (ivcomp - 6) 24040,14040,24040
214: 14040 ivpass = ivpass + 1
215: write (i02,80001) ivtnum
216: go to 4051
217: 24040 ivfail = ivfail + 1
218: ivcorr = 6
219: write (i02,80004) ivtnum, ivcomp ,ivcorr
220: 4051 continue
221: ivtnum = 405
222: c
223: c **** test 405 ****
224: c
225: if (iczero) 34050, 4050, 34050
226: 4050 continue
227: ivcn01 = 10
228: call fs053 (6,ivcn01,11,ivon04,2)
229: ivcomp = ivon04
230: go to 44050
231: 34050 ivdele = ivdele + 1
232: write (i02,80003) ivtnum
233: if (iczero) 44050, 4061, 44050
234: 44050 if (ivcomp - 16) 24050,14050,24050
235: 14050 ivpass = ivpass + 1
236: write (i02,80001) ivtnum
237: go to 4061
238: 24050 ivfail = ivfail + 1
239: ivcorr = 16
240: write (i02,80004) ivtnum, ivcomp ,ivcorr
241: 4061 continue
242: ivtnum = 406
243: c
244: c **** test 406 ****
245: c
246: if (iczero) 34060, 4060, 34060
247: 4060 continue
248: ivon01 = 6
249: ivon02 = 10
250: ivon03 = 11
251: ivon05 = 3
252: call fs053 (ivon01,ivon02,ivon03,ivon04,ivon05)
253: ivcomp = ivon04
254: go to 44060
255: 34060 ivdele = ivdele + 1
256: write (i02,80003) ivtnum
257: if (iczero) 44060, 4071, 44060
258: 44060 if (ivcomp - 27) 24060,14060,24060
259: 14060 ivpass = ivpass + 1
260: write (i02,80001) ivtnum
261: go to 4071
262: 24060 ivfail = ivfail + 1
263: ivcorr = 27
264: write (i02,80004) ivtnum, ivcomp ,ivcorr
265: 4071 continue
266: c
267: c test 407 through 409 test the reference to function ff054 which
268: c contains several arguments and several return statements
269: c
270: ivtnum = 407
271: c
272: c **** test 407 ****
273: c
274: if (iczero) 34070, 4070, 34070
275: 4070 continue
276: ivcomp = ff054 (300,1,21,1)
277: go to 44070
278: 34070 ivdele = ivdele + 1
279: write (i02,80003) ivtnum
280: if (iczero) 44070, 4081, 44070
281: 44070 if (ivcomp - 300) 24070,14070,24070
282: 14070 ivpass = ivpass + 1
283: write (i02,80001) ivtnum
284: go to 4081
285: 24070 ivfail = ivfail + 1
286: ivcorr = 300
287: write (i02,80004) ivtnum, ivcomp ,ivcorr
288: 4081 continue
289: ivtnum = 408
290: c
291: c **** test 408 ****
292: c
293: if (iczero) 34080, 4080, 34080
294: 4080 continue
295: ivon01 = 300
296: ivon04 = 2
297: ivcomp = ff054 (ivon01,77,5,ivon04)
298: go to 44080
299: 34080 ivdele = ivdele + 1
300: write (i02,80003) ivtnum
301: if (iczero) 44080, 4091, 44080
302: 44080 if (ivcomp - 377) 24080,14080,24080
303: 14080 ivpass = ivpass + 1
304: write (i02,80001) ivtnum
305: go to 4091
306: 24080 ivfail = ivfail + 1
307: ivcorr = 377
308: write (i02,80004) ivtnum, ivcomp ,ivcorr
309: 4091 continue
310: ivtnum = 409
311: c
312: c **** test 409 ****
313: c
314: if (iczero) 34090, 4090, 34090
315: 4090 continue
316: ivon01 = 71
317: ivon02 = 21
318: ivon03 = 17
319: ivon04 = 3
320: ivcomp = ff054 (ivon01,ivon02,ivon03,ivon04)
321: go to 44090
322: 34090 ivdele = ivdele + 1
323: write (i02,80003) ivtnum
324: if (iczero) 44090, 4101, 44090
325: 44090 if (ivcomp - 109) 24090,14090,24090
326: 14090 ivpass = ivpass + 1
327: write (i02,80001) ivtnum
328: go to 4101
329: 24090 ivfail = ivfail + 1
330: ivcorr = 109
331: write (i02,80004) ivtnum, ivcomp ,ivcorr
332: 4101 continue
333: c
334: c test 410 through 429 test the call to subroutine fs055 which
335: c contains no arguments. the parameters are passed through an
336: c integer array variable in unlabeled common.
337: c
338: call fs055
339: do 20 i = 1,20
340: if (iczero) 34100, 4100, 34100
341: 4100 continue
342: ivtnum = 409 + i
343: ivcomp = iacn11(i)
344: go to 44100
345: 34100 ivdele = ivdele + 1
346: write (i02,80003) ivtnum
347: if (iczero) 44100, 4111, 44100
348: 44100 if (ivcomp - i) 24100,14100,24100
349: 14100 ivpass = ivpass + 1
350: write (i02,80001) ivtnum
351: go to 4111
352: 24100 ivfail = ivfail + 1
353: ivcorr = i
354: write (i02,80004) ivtnum, ivcomp ,ivcorr
355: 4111 continue
356: 20 continue
357: c
358: c write page footings and run summaries
359: 99999 continue
360: write (i02,90002)
361: write (i02,90006)
362: write (i02,90002)
363: write (i02,90002)
364: write (i02,90007)
365: write (i02,90002)
366: write (i02,90008) ivfail
367: write (i02,90009) ivpass
368: write (i02,90010) ivdele
369: c
370: c
371: c terminate routine execution
372: stop
373: c
374: c format statements for page headers
375: 90000 format (1h1)
376: 90002 format (1h )
377: 90001 format (1h ,10x,34hfortran compiler validation system)
378: 90003 format (1h ,21x,11hversion 1.0)
379: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
380: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
381: 90006 format (1h ,5x,46h----------------------------------------------)
382: 90011 format (1h ,18x,17hsubset level test)
383: c
384: c format statements for run summaries
385: 90008 format (1h ,15x,i5,19h errors encountered)
386: 90009 format (1h ,15x,i5,13h tests passed)
387: 90010 format (1h ,15x,i5,14h tests deleted)
388: c
389: c format statements for test results
390: 80001 format (1h ,4x,i5,7x,4hpass)
391: 80002 format (1h ,4x,i5,7x,4hfail)
392: 80003 format (1h ,4x,i5,7x,7hdeleted)
393: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
394: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
395: c
396: 90007 format (1h ,20x,20hend of program fm050)
397: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.