![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm024.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 fm024.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 fm024
4: c
5: c three 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 icoe01, rcoe01, lcoe01
27: common iade31(3,3,3), rade31(3,3,3), lade31(3,3,3)
28: common iadn31(2,2,2), radn31(2,2,2), ladn31(2,2,2)
29: c
30: dimension iade32(3,3,3), rade32(3,3,3), lade32(3,3,3)
31: dimension iadn32(2,2,2), iadn21(2,2), iadn11(2)
32: dimension iade21(2,2), iade11(4)
33: c
34: equivalence (iade31(1,1,1), iade32(1,1,1) )
35: equivalence ( rade31(1,1,1), rade32(1,1,1) )
36: equivalence ( lade31(1,1,1), lade32(1,1,1) )
37: equivalence ( iade31(1,1,1), iade21(1,1), iade11(1) )
38: equivalence ( icoe01, icoe02, icoe03 )
39: c
40: logical lade31, ladn31, lade32, lcoe01
41: integer radn33(2,2,2), radn21(2,4), radn11(8)
42: real iadn33(2,2,2), iadn22(2,4), iadn12(8)
43: c
44: c
45: c **********************************************************
46: c
47: c a compiler validation system for the fortran language
48: c based on specifications as defined in american national standard
49: c programming language fortran x3.9-1978, has been developed by the
50: c federal cobol compiler testing service. the fortran compiler
51: c validation system (fcvs) consists of audit routines, their related
52: c data, and an executive system. each audit routine is a fortran
53: c program, subprogram or function which includes tests of specific
54: c language elements and supporting procedures indicating the result
55: c of executing these tests.
56: c
57: c this particular program/subprogram/function contains features
58: c found only in the subset as defined in x3.9-1978.
59: c
60: c suggestions and comments should be forwarded to -
61: c
62: c department of the navy
63: c federal cobol compiler testing service
64: c washington, d.c. 20376
65: c
66: c **********************************************************
67: c
68: c
69: c
70: c initialization section
71: c
72: c initialize constants
73: c **************
74: c i01 contains the logical unit number for the card reader.
75: i01 = 5
76: c i02 contains the logical unit number for the printer.
77: i02 = 6
78: c system environment section
79: c
80: cx010 this card is replaced by contents of fexec x-010 control card.
81: c the cx010 card is for overriding the program default i01 = 5
82: c (unit number for card reader).
83: cx011 this card is replaced by contents of fexec x-011 control card.
84: c the cx011 card is for systems which require additional
85: c fortran statements for files associated with cx010 above.
86: c
87: cx020 this card is replaced by contents of fexec x-020 control card.
88: c the cx020 card is for overriding the program default i02 = 6
89: c (unit number for printer).
90: cx021 this card is replaced by contents of fexec x-021 control card.
91: c the cx021 card is for systems which require additional
92: c fortran statements for files associated with cx020 above.
93: c
94: ivpass=0
95: ivfail=0
96: ivdele=0
97: iczero=0
98: c
99: c write page headers
100: write (i02,90000)
101: write (i02,90001)
102: write (i02,90002)
103: write (i02, 90002)
104: write (i02,90003)
105: write (i02,90002)
106: write (i02,90004)
107: write (i02,90002)
108: write (i02,90011)
109: write (i02,90002)
110: write (i02,90002)
111: write (i02,90005)
112: write (i02,90006)
113: write (i02,90002)
114: ivtnum = 645
115: c
116: c **** test 645 ****
117: c test 645 - tests setting a three dimension integer array element
118: c by a simple integer assignment statement.
119: c
120: if (iczero) 36450, 6450, 36450
121: 6450 continue
122: iadn31(2,2,2) = -9999
123: ivcomp = iadn31(2,2,2)
124: go to 46450
125: 36450 ivdele = ivdele + 1
126: write (i02,80003) ivtnum
127: if (iczero) 46450, 6461, 46450
128: 46450 if ( ivcomp + 9999 ) 26450, 16450, 26450
129: 16450 ivpass = ivpass + 1
130: write (i02,80001) ivtnum
131: go to 6461
132: 26450 ivfail = ivfail + 1
133: ivcorr = -9999
134: write (i02,80004) ivtnum, ivcomp ,ivcorr
135: 6461 continue
136: ivtnum = 646
137: c
138: c **** test 646 ****
139: c test 646 - tests setting a three dimension real array element
140: c by a simple real assignment statement.
141: c
142: if (iczero) 36460, 6460, 36460
143: 6460 continue
144: radn31(1,2,1) = 512.
145: ivcomp = radn31(1,2,1)
146: go to 46460
147: 36460 ivdele = ivdele + 1
148: write (i02,80003) ivtnum
149: if (iczero) 46460, 6471, 46460
150: 46460 if ( ivcomp - 512 ) 26460, 16460, 26460
151: 16460 ivpass = ivpass + 1
152: write (i02,80001) ivtnum
153: go to 6471
154: 26460 ivfail = ivfail + 1
155: ivcorr = 512
156: write (i02,80004) ivtnum, ivcomp ,ivcorr
157: 6471 continue
158: ivtnum = 647
159: c
160: c **** test 647 ****
161: c test 647 - tests setting a three dimension logical array element
162: c by a simple logical assignment statement.
163: c
164: if (iczero) 36470, 6470, 36470
165: 6470 continue
166: ladn31(1,2,2) = .true.
167: icon01 = 0
168: if ( ladn31(1,2,2) ) icon01 = 1
169: go to 46470
170: 36470 ivdele = ivdele + 1
171: write (i02,80003) ivtnum
172: if (iczero) 46470, 6481, 46470
173: 46470 if ( icon01 - 1 ) 26470, 16470, 26470
174: 16470 ivpass = ivpass + 1
175: write (i02,80001) ivtnum
176: go to 6481
177: 26470 ivfail = ivfail + 1
178: ivcomp = icon01
179: ivcorr = 1
180: write (i02,80004) ivtnum, ivcomp ,ivcorr
181: 6481 continue
182: ivtnum = 648
183: c
184: c **** test 648 ****
185: c test 648 - tests setting a one, two, and three dimension array
186: c element to a value in arithmetic assignment statements. all three
187: c elements are integers. the integer array elements are then used
188: c in an arithmetic statement and the result is stored by integer
189: c to real conversion into a three dimension real array element.
190: c
191: if (iczero) 36480, 6480, 36480
192: 6480 continue
193: iadn11(2) = 1
194: iadn21(2,2) = 2
195: iadn32(2,2,2) = 3
196: radn31(2,2,1) = iadn11(2) + iadn21(2,2) + iadn32(2,2,2)
197: ivcomp = radn31(2,2,1)
198: go to 46480
199: 36480 ivdele = ivdele + 1
200: write (i02,80003) ivtnum
201: if (iczero) 46480, 6491, 46480
202: 46480 if ( ivcomp - 6) 26480, 16480, 26480
203: 16480 ivpass = ivpass + 1
204: write (i02,80001) ivtnum
205: go to 6491
206: 26480 ivfail = ivfail + 1
207: ivcorr = 6
208: write (i02,80004) ivtnum, ivcomp ,ivcorr
209: 6491 continue
210: ivtnum = 649
211: c
212: c **** test 649 ****
213: c test 649 - tests of one, two, and three dimension array elements
214: c set explicitly integer by the integer type statement. all element
215: c values should be zero from real to integer truncation from a value
216: c of 0.5. all three elements are used in an arithmetic expression.
217: c the value of the sum of the elements should be zero.
218: c
219: if (iczero) 36490, 6490, 36490
220: 6490 continue
221: radn11(8) = 0000.50000
222: radn21(2,4) = .50000
223: radn33(2,2,2) = 00000.5
224: radn11(1) = radn11(8) + radn21(2,4) + radn33(2,2,2)
225: ivcomp = radn11(1)
226: go to 46490
227: 36490 ivdele = ivdele + 1
228: write (i02,80003) ivtnum
229: if (iczero) 46490, 6501, 46490
230: 46490 if ( ivcomp - 0 ) 26490, 16490, 26490
231: 16490 ivpass = ivpass + 1
232: write (i02,80001) ivtnum
233: go to 6501
234: 26490 ivfail = ivfail + 1
235: ivcorr = 0
236: write (i02,80004) ivtnum, ivcomp ,ivcorr
237: 6501 continue
238: ivtnum = 650
239: c
240: c **** test 650 ****
241: c test 650 - test of the equivalence statement. a real array
242: c element is set by an assignment statement. its equivalent element
243: c in common is used to set the value of an integer array element
244: c also in common. finally the dimensioned equivalent integer
245: c array element is tested for the value used throughout 32767.
246: c
247: if (iczero) 36500, 6500, 36500
248: 6500 continue
249: rade32(2,2,2) = 32767.
250: iade31(2,2,2) = rade31(2,2,2)
251: ivcomp = iade32(2,2,2)
252: go to 46500
253: 36500 ivdele = ivdele + 1
254: write (i02,80003) ivtnum
255: if (iczero) 46500, 6511, 46500
256: 46500 if ( ivcomp - 32767 ) 26500, 16500, 26500
257: 16500 ivpass = ivpass + 1
258: write (i02,80001) ivtnum
259: go to 6511
260: 26500 ivfail = ivfail + 1
261: ivcorr = 32767
262: write (i02,80004) ivtnum, ivcomp ,ivcorr
263: 6511 continue
264: ivtnum = 651
265: c
266: c **** test 651 ****
267: c test 651 - this is a test of common and dimension as well as a
268: c test of the equivalence statement using logical array elements
269: c both in common and dimensioned. a logical variable in common is
270: c set to a value of .not. the value used in the equivalenced array
271: c elements which were set in a logical assignment statement.
272: c
273: if (iczero) 36510, 6510, 36510
274: 6510 continue
275: lade31(1,2,3) = .false.
276: lcoe01 = .not. lade32(1,2,3)
277: icon01 = 0
278: if ( lcoe01 ) icon01 = 1
279: go to 46510
280: 36510 ivdele = ivdele + 1
281: write (i02,80003) ivtnum
282: if (iczero) 46510, 6521, 46510
283: 46510 if ( icon01 - 1 ) 26510, 16510, 26510
284: 16510 ivpass = ivpass + 1
285: write (i02,80001) ivtnum
286: go to 6521
287: 26510 ivfail = ivfail + 1
288: ivcomp = icon01
289: ivcorr = 1
290: write (i02,80004) ivtnum, ivcomp ,ivcorr
291: 6521 continue
292: ivtnum = 652
293: c
294: c **** test 652 ****
295: c test 652 - tests of one, two, and three dimension array elements
296: c set explicitly real by the real type statement. all element
297: c values should be 0.5 from the real assignment statement. the
298: c array elements are summed and then the sum multiplied by 2.
299: c finally 0.2 is added to the result and the final result converted
300: c to an integer ( ( .5 + .5 + .5 ) * 2. ) + 0.2
301: c
302: if (iczero) 36520, 6520, 36520
303: 6520 continue
304: iadn12(5) = 0.5
305: iadn22(1,3) = 0.5
306: iadn33(1,2,2) = 0.5
307: ivcomp = ( ( iadn12(5) + iadn22(1,3) + iadn33(1,2,2) ) * 2. ) + .2
308: go to 46520
309: 36520 ivdele = ivdele + 1
310: write (i02,80003) ivtnum
311: if (iczero) 46520, 6531, 46520
312: 46520 if ( ivcomp - 3 ) 26520, 16520, 26520
313: 16520 ivpass = ivpass + 1
314: write (i02,80001) ivtnum
315: go to 6531
316: 26520 ivfail = ivfail + 1
317: ivcorr = 3
318: write (i02,80004) ivtnum, ivcomp ,ivcorr
319: 6531 continue
320: c
321: c write page footings and run summaries
322: 99999 continue
323: write (i02,90002)
324: write (i02,90006)
325: write (i02,90002)
326: write (i02,90002)
327: write (i02,90007)
328: write (i02,90002)
329: write (i02,90008) ivfail
330: write (i02,90009) ivpass
331: write (i02,90010) ivdele
332: c
333: c
334: c terminate routine execution
335: stop
336: c
337: c format statements for page headers
338: 90000 format (1h1)
339: 90002 format (1h )
340: 90001 format (1h ,10x,34hfortran compiler validation system)
341: 90003 format (1h ,21x,11hversion 1.0)
342: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
343: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
344: 90006 format (1h ,5x,46h----------------------------------------------)
345: 90011 format (1h ,18x,17hsubset level test)
346: c
347: c format statements for run summaries
348: 90008 format (1h ,15x,i5,19h errors encountered)
349: 90009 format (1h ,15x,i5,13h tests passed)
350: 90010 format (1h ,15x,i5,14h tests deleted)
351: c
352: c format statements for test results
353: 80001 format (1h ,4x,i5,7x,4hpass)
354: 80002 format (1h ,4x,i5,7x,4hfail)
355: 80003 format (1h ,4x,i5,7x,7hdeleted)
356: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
357: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
358: c
359: 90007 format (1h ,20x,20hend of program fm024)
360: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.