![[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 [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests|
Return to fm023.f CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests |
1.1 root 1: c comment section.
2: c
3: c fm023
4: c
5: c two dimensioned arrays are used in this routine.
6: c this routine tests arrays with fixed dimension and size limits
7: c set either in a blank common or dimension statement. the values
8: c of the array elements are set in various ways such as simple
9: c assignment statements, set to the values of other array elements
10: c (either positive or negative), set by integer to real or real to
11: c integer conversion, set by arithmetic expressions, or set by
12: c use of the equivalence statement.
13: c
14: c
15: c references
16: c american national standard programming language fortran,
17: c x3.9-1978
18: c
19: c section 8, specification statements
20: c section 8.1, dimension statement
21: c section 8.2, equivalence statement
22: c section 8.3, common statement
23: c section 8.4, type-statements
24: c section 9, data statement
25: c
26: common iadn22(2,2), radn22(2,2), icoe01, rcoe01
27: dimension iadn21(2,2), radn21(2,2)
28: dimension iade23(2,2), iade24(2,2), rade23(2,2), rade24(2,2)
29: equivalence (iade23(2,2),iadn22(2,2),iade24(2,2))
30: equivalence (rade23(2,2),radn22(2,2),rade24(2,2))
31: equivalence (icoe01,icoe02,icoe03,icoe04), (rcoe01,rcoe02,rcoe03)
32: integer radn11(2), radn25(2,2)
33: logical ladn21(2,2)
34: data radn21(2,2)/-512./
35: data ladn21/4*.true./
36: c
37: c **********************************************************
38: c
39: c a compiler validation system for the fortran language
40: c based on specifications as defined in american national standard
41: c programming language fortran x3.9-1978, has been developed by the
42: c federal cobol compiler testing service. the fortran compiler
43: c validation system (fcvs) consists of audit routines, their related
44: c data, and an executive system. each audit routine is a fortran
45: c program, subprogram or function which includes tests of specific
46: c language elements and supporting procedures indicating the result
47: c of executing these tests.
48: c
49: c this particular program/subprogram/function contains features
50: c found only in the subset as defined in x3.9-1978.
51: c
52: c suggestions and comments should be forwarded to -
53: c
54: c department of the navy
55: c federal cobol compiler testing service
56: c washington, d.c. 20376
57: c
58: c **********************************************************
59: c
60: c
61: c
62: c initialization section
63: c
64: c initialize constants
65: c **************
66: c i01 contains the logical unit number for the card reader.
67: i01 = 5
68: c i02 contains the logical unit number for the printer.
69: i02 = 6
70: c system environment section
71: c
72: cx010 this card is replaced by contents of fexec x-010 control card.
73: c the cx010 card is for overriding the program default i01 = 5
74: c (unit number for card reader).
75: cx011 this card is replaced by contents of fexec x-011 control card.
76: c the cx011 card is for systems which require additional
77: c fortran statements for files associated with cx010 above.
78: c
79: cx020 this card is replaced by contents of fexec x-020 control card.
80: c the cx020 card is for overriding the program default i02 = 6
81: c (unit number for printer).
82: cx021 this card is replaced by contents of fexec x-021 control card.
83: c the cx021 card is for systems which require additional
84: c fortran statements for files associated with cx020 above.
85: c
86: ivpass=0
87: ivfail=0
88: ivdele=0
89: iczero=0
90: c
91: c write page headers
92: write (i02,90000)
93: write (i02,90001)
94: write (i02,90002)
95: write (i02, 90002)
96: write (i02,90003)
97: write (i02,90002)
98: write (i02,90004)
99: write (i02,90002)
100: write (i02,90011)
101: write (i02,90002)
102: write (i02,90002)
103: write (i02,90005)
104: write (i02,90006)
105: write (i02,90002)
106: ivtnum = 632
107: c
108: c **** test 632 ****
109: c test 632 - tests setting an integer array element by a
110: c simple assignment statement to the value 9999.
111: c
112: if (iczero) 36320, 6320, 36320
113: 6320 continue
114: iadn21(1,1) = 9999
115: ivcomp = iadn21(1,1)
116: go to 46320
117: 36320 ivdele = ivdele + 1
118: write (i02,80003) ivtnum
119: if (iczero) 46320, 6331, 46320
120: 46320 if ( ivcomp - 9999 ) 26320, 16320, 26320
121: 16320 ivpass = ivpass + 1
122: write (i02,80001) ivtnum
123: go to 6331
124: 26320 ivfail = ivfail + 1
125: ivcorr = 9999
126: write (i02,80004) ivtnum, ivcomp ,ivcorr
127: 6331 continue
128: ivtnum = 633
129: c
130: c **** test 633 ****
131: c test 633 - tests setting a real array element by a simple
132: c assignment statement to the value -32766.
133: c
134: if (iczero) 36330, 6330, 36330
135: 6330 continue
136: radn21(1,2) = -32766.
137: ivcomp = radn21(1,2)
138: go to 46330
139: 36330 ivdele = ivdele + 1
140: write (i02,80003) ivtnum
141: if (iczero) 46330, 6341, 46330
142: 46330 if ( ivcomp + 32766 ) 26330, 16330, 26330
143: 16330 ivpass = ivpass + 1
144: write (i02,80001) ivtnum
145: go to 6341
146: 26330 ivfail = ivfail + 1
147: ivcorr = -32766
148: write (i02,80004) ivtnum, ivcomp ,ivcorr
149: 6341 continue
150: ivtnum = 634
151: c
152: c **** test 634 ****
153: c test 634 - test of the data initialization statement and setting
154: c an integer array element equal to the value of a real array
155: c element. the value used is -512.
156: c
157: if (iczero) 36340, 6340, 36340
158: 6340 continue
159: iadn21(2,2) = radn21(2,2)
160: ivcomp = iadn21(2,2)
161: go to 46340
162: 36340 ivdele = ivdele + 1
163: write (i02,80003) ivtnum
164: if (iczero) 46340, 6351, 46340
165: 46340 if ( ivcomp + 512 ) 26340, 16340, 26340
166: 16340 ivpass = ivpass + 1
167: write (i02,80001) ivtnum
168: go to 6351
169: 26340 ivfail = ivfail + 1
170: ivcorr = -512
171: write (i02,80004) ivtnum, ivcomp ,ivcorr
172: 6351 continue
173: ivtnum = 635
174: c
175: c **** test 635 ****
176: c test 635 - test of setting a two dimensioned array element
177: c equal to the value of a one dimensioned array element.
178: c both arrays are set integer by the type statement and the two
179: c dimensioned array element is minus the value of the one dimension
180: c element. the value used is 3.
181: c
182: if (iczero) 36350, 6350, 36350
183: 6350 continue
184: radn11(1) = 3
185: radn25(2,2) = - radn11(1)
186: ivcomp = radn25(2,2)
187: go to 46350
188: 36350 ivdele = ivdele + 1
189: write (i02,80003) ivtnum
190: if (iczero) 46350, 6361, 46350
191: 46350 if ( ivcomp + 3 ) 26350, 16350, 26350
192: 16350 ivpass = ivpass + 1
193: write (i02,80001) ivtnum
194: go to 6361
195: 26350 ivfail = ivfail + 1
196: ivcorr = -3
197: write (i02,80004) ivtnum, ivcomp ,ivcorr
198: 6361 continue
199: ivtnum = 636
200: c
201: c **** test 636 ****
202: c test 636 - test of logical array elements set by data statements
203: c
204: if (iczero) 36360, 6360, 36360
205: 6360 continue
206: icon01 = 0
207: if ( ladn21(2,1) ) icon01 = 1
208: go to 46360
209: 36360 ivdele = ivdele + 1
210: write (i02,80003) ivtnum
211: if (iczero) 46360, 6371, 46360
212: 46360 if ( icon01 - 1 ) 26360, 16360, 26360
213: 16360 ivpass = ivpass + 1
214: write (i02,80001) ivtnum
215: go to 6371
216: 26360 ivfail = ivfail + 1
217: ivcomp = icon01
218: ivcorr = 1
219: write (i02,80004) ivtnum, ivcomp ,ivcorr
220: 6371 continue
221: ivtnum = 637
222: c
223: c **** test 637 ****
224: c test 637 - test of real to integer conversion and setting
225: c integer array elements to the value obtained in an arithmetic
226: c expression using real array elements. .5 + .5 = 1
227: c
228: if (iczero) 36370, 6370, 36370
229: 6370 continue
230: radn21(1,2) = 00000.5
231: radn21(2,1) = .500000
232: iadn21(2,1) = radn21(1,2) + radn21(2,1)
233: ivcomp = iadn21(2,1)
234: go to 46370
235: 36370 ivdele = ivdele + 1
236: write (i02,80003) ivtnum
237: if (iczero) 46370, 6381, 46370
238: 46370 if ( ivcomp - 1 ) 26370, 16370, 26370
239: 16370 ivpass = ivpass + 1
240: write (i02,80001) ivtnum
241: go to 6381
242: 26370 ivfail = ivfail + 1
243: ivcorr = 1
244: write (i02,80004) ivtnum, ivcomp ,ivcorr
245: 6381 continue
246: ivtnum = 638
247: c
248: c **** test 638 ****
249: c test 638 - test of equivalence of three integer arrays one of
250: c which is in common.
251: c
252: if (iczero) 36380, 6380, 36380
253: 6380 continue
254: iadn22(2,1) = -9999
255: ivcomp = iade23(2,1)
256: go to 46380
257: 36380 ivdele = ivdele + 1
258: write (i02,80003) ivtnum
259: if (iczero) 46380, 6391, 46380
260: 46380 if ( ivcomp + 9999 ) 26380, 16380, 26380
261: 16380 ivpass = ivpass + 1
262: write (i02,80001) ivtnum
263: go to 6391
264: 26380 ivfail = ivfail + 1
265: ivcorr = -9999
266: write (i02,80004) ivtnum, ivcomp ,ivcorr
267: 6391 continue
268: ivtnum = 639
269: c
270: c **** test 639 ****
271: c test 639 - like test 638 only the other equivalenced array is
272: c tested for the value -9999.
273: c
274: if (iczero) 36390, 6390, 36390
275: 6390 continue
276: iade23(2,1) = -9999
277: ivcomp = iade24(2,1)
278: go to 46390
279: 36390 ivdele = ivdele + 1
280: write (i02,80003) ivtnum
281: if (iczero) 46390, 6401, 46390
282: 46390 if ( ivcomp + 9999 ) 26390, 16390, 26390
283: 16390 ivpass = ivpass + 1
284: write (i02,80001) ivtnum
285: go to 6401
286: 26390 ivfail = ivfail + 1
287: ivcorr = -9999
288: write (i02,80004) ivtnum, ivcomp ,ivcorr
289: 6401 continue
290: ivtnum = 640
291: c
292: c **** test 640 ****
293: c test 640 - test of three real arrays that are equivalenced.
294: c one of the arrays is in common. the value 512 is set into one of
295: c the dimensioned array elements by an integer to real conversion
296: c assignment statement.
297: c
298: if (iczero) 36400, 6400, 36400
299: 6400 continue
300: rade24(2,2) = 512
301: ivcomp = radn22(2,2)
302: go to 46400
303: 36400 ivdele = ivdele + 1
304: write (i02,80003) ivtnum
305: if (iczero) 46400, 6411, 46400
306: 46400 if ( ivcomp - 512 ) 26400, 16400, 26400
307: 16400 ivpass = ivpass + 1
308: write (i02,80001) ivtnum
309: go to 6411
310: 26400 ivfail = ivfail + 1
311: ivcorr = 512
312: write (i02,80004) ivtnum, ivcomp ,ivcorr
313: 6411 continue
314: ivtnum = 641
315: c
316: c **** test 641 ****
317: c test 641 - like test 640 only the other equivalenced array is
318: c tested for the value 512.
319: c
320: if (iczero) 36410, 6410, 36410
321: 6410 continue
322: radn22(2,2) = 512
323: ivcomp = rade23(2,2)
324: go to 46410
325: 36410 ivdele = ivdele + 1
326: write (i02,80003) ivtnum
327: if (iczero) 46410, 6421, 46410
328: 46410 if ( ivcomp - 512 ) 26410, 16410, 26410
329: 16410 ivpass = ivpass + 1
330: write (i02,80001) ivtnum
331: go to 6421
332: 26410 ivfail = ivfail + 1
333: ivcorr = 512
334: write (i02,80004) ivtnum, ivcomp ,ivcorr
335: 6421 continue
336: ivtnum = 642
337: c
338: c **** test 642 ****
339: c test 642 - test of four integer variables that are equivalenced.
340: c one of the integer variables is in blank common. the value used
341: c is 3 set by an assignment statement.
342: c
343: if (iczero) 36420, 6420, 36420
344: 6420 continue
345: icoe03 = 3
346: ivcomp = icoe01
347: go to 46420
348: 36420 ivdele = ivdele + 1
349: write (i02,80003) ivtnum
350: if (iczero) 46420, 6431, 46420
351: 46420 if ( ivcomp - 3 ) 26420, 16420, 26420
352: 16420 ivpass = ivpass + 1
353: write (i02,80001) ivtnum
354: go to 6431
355: 26420 ivfail = ivfail + 1
356: ivcorr = 3
357: write (i02,80004) ivtnum, ivcomp ,ivcorr
358: 6431 continue
359: ivtnum = 643
360: c
361: c **** test 643 ****
362: c test 643 - like test 642 but another of the elements is tested
363: c by an arithmetic expression using the equivalenced elements.
364: c the value of all of the elements should inititially be 3 since
365: c they all should share the same storage location. icoe04 = 3+3+3+3
366: c icoe04 = 12 then the element icoe02 is tested for the value 12.
367: c
368: if (iczero) 36430, 6430, 36430
369: 6430 continue
370: icoe01 = 3
371: icoe04 = icoe01 + icoe02 + icoe03 + icoe04
372: ivcomp = icoe02
373: go to 46430
374: 36430 ivdele = ivdele + 1
375: write (i02,80003) ivtnum
376: if (iczero) 46430, 6441, 46430
377: 46430 if ( ivcomp - 12 ) 26430, 16430, 26430
378: 16430 ivpass = ivpass + 1
379: write (i02,80001) ivtnum
380: go to 6441
381: 26430 ivfail = ivfail + 1
382: ivcorr = 12
383: write (i02,80004) ivtnum, ivcomp ,ivcorr
384: 6441 continue
385: ivtnum = 644
386: c
387: c **** test 644 ****
388: c test 644 - test of equivalence with three real variables one
389: c of which is in blank common. the elements are set initially to .5
390: c then all of the elements are used in an arithmetic expression
391: c rcoe01 =(.5 + .5 + .5) * 2. so rcoe01 = 3. element rcoe02
392: c is tested for the value 3.
393: c
394: if (iczero) 36440, 6440, 36440
395: 6440 continue
396: rcoe02 = 0.5
397: rcoe01 = ( rcoe01 + rcoe02 + rcoe03 ) * 2.
398: ivcomp = rcoe02
399: go to 46440
400: 36440 ivdele = ivdele + 1
401: write (i02,80003) ivtnum
402: if (iczero) 46440, 6451, 46440
403: 46440 if ( ivcomp - 3 ) 26440, 16440, 26440
404: 16440 ivpass = ivpass + 1
405: write (i02,80001) ivtnum
406: go to 6451
407: 26440 ivfail = ivfail + 1
408: ivcorr = 3
409: write (i02,80004) ivtnum, ivcomp ,ivcorr
410: 6451 continue
411: c
412: c write page footings and run summaries
413: 99999 continue
414: write (i02,90002)
415: write (i02,90006)
416: write (i02,90002)
417: write (i02,90002)
418: write (i02,90007)
419: write (i02,90002)
420: write (i02,90008) ivfail
421: write (i02,90009) ivpass
422: write (i02,90010) ivdele
423: c
424: c
425: c terminate routine execution
426: stop
427: c
428: c format statements for page headers
429: 90000 format (1h1)
430: 90002 format (1h )
431: 90001 format (1h ,10x,34hfortran compiler validation system)
432: 90003 format (1h ,21x,11hversion 1.0)
433: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
434: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
435: 90006 format (1h ,5x,46h----------------------------------------------)
436: 90011 format (1h ,18x,17hsubset level test)
437: c
438: c format statements for run summaries
439: 90008 format (1h ,15x,i5,19h errors encountered)
440: 90009 format (1h ,15x,i5,13h tests passed)
441: 90010 format (1h ,15x,i5,14h tests deleted)
442: c
443: c format statements for test results
444: 80001 format (1h ,4x,i5,7x,4hpass)
445: 80002 format (1h ,4x,i5,7x,4hfail)
446: 80003 format (1h ,4x,i5,7x,7hdeleted)
447: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
448: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
449: c
450: 90007 format (1h ,20x,20hend of program fm023)
451: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.