![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm020.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 fm020.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 fm020
5: c
6: c this routine tests the fortran in-line statement function
7: c of type logical and integer. integer constants, logical constants
8: c integer variables, logical variables, integer arithmetic express-
9: c ions are all used to test the statement function definition and
10: c the value returned for the statement function when it is used
11: c in the main body of the program.
12: c
13: c references
14: c american national standard programming language fortran,
15: c x3.9-1978
16: c
17: c section 8.4.1, integer, real, double precision, complex, and
18: c logical type-statements
19: c section 15.3.2, intrinsic function references
20: c section 15.4, statement functions
21: c section 15.4.1, forms of a function statement
22: c section 15.4.2, referencing a statement function
23: c section 15.5.2, external function references
24: c
25: logical lftn01, ldtn01
26: logical lftn02, ldtn02
27: logical lftn03, ldtn03, lctn03
28: logical lftn04, ldtn04, lctn04
29: dimension iadn11(2)
30: c
31: c..... test 553
32: ifon01(idon01) = 32767
33: c
34: c..... test 554
35: lftn01(ldtn01) = .true.
36: c
37: c..... test 555
38: ifon02 ( idon02 ) = idon02
39: c
40: c..... test 556
41: lftn02( ldtn02 ) = ldtn02
42: c
43: c..... test 557
44: ifon03 (idon03 )= idon03
45: c
46: c..... test 558
47: lftn03(ldtn03) = ldtn03
48: c
49: c..... test 559
50: lftn04(ldtn04) = .not. ldtn04
51: c
52: c..... test 560
53: ifon04(idon04) = idon04 ** 2
54: c
55: c..... test 561
56: ifon05(idon05, idon06) = idon05 + idon06
57: c
58: c..... test 562
59: ifon06(idon07, idon08) = sqrt(float(idon07**2)+float(idon08**2))
60: c
61: c..... test 563
62: ifon07(idon09) = idon09 ** 2
63: ifon08(i,j)=sqrt(float(ifon07(i))+float(ifon07(j)))
64: c
65: c..... test 564
66: ifon09(k,l) = k / l + k ** l - k * l
67: c
68: c
69: c
70: c **********************************************************
71: c
72: c a compiler validation system for the fortran language
73: c based on specifications as defined in american national standard
74: c programming language fortran x3.9-1978, has been developed by the
75: c federal cobol compiler testing service. the fortran compiler
76: c validation system (fcvs) consists of audit routines, their related
77: c data, and an executive system. each audit routine is a fortran
78: c program, subprogram or function which includes tests of specific
79: c language elements and supporting procedures indicating the result
80: c of executing these tests.
81: c
82: c this particular program/subprogram/function contains features
83: c found only in the subset as defined in x3.9-1978.
84: c
85: c suggestions and comments should be forwarded to -
86: c
87: c department of the navy
88: c federal cobol compiler testing service
89: c washington, d.c. 20376
90: c
91: c **********************************************************
92: c
93: c
94: c
95: c initialization section
96: c
97: c initialize constants
98: c **************
99: c i01 contains the logical unit number for the card reader.
100: i01 = 5
101: c i02 contains the logical unit number for the printer.
102: i02 = 6
103: c system environment section
104: c
105: cx010 this card is replaced by contents of fexec x-010 control card.
106: c the cx010 card is for overriding the program default i01 = 5
107: c (unit number for card reader).
108: cx011 this card is replaced by contents of fexec x-011 control card.
109: c the cx011 card is for systems which require additional
110: c fortran statements for files associated with cx010 above.
111: c
112: cx020 this card is replaced by contents of fexec x-020 control card.
113: c the cx020 card is for overriding the program default i02 = 6
114: c (unit number for printer).
115: cx021 this card is replaced by contents of fexec x-021 control card.
116: c the cx021 card is for systems which require additional
117: c fortran statements for files associated with cx020 above.
118: c
119: ivpass=0
120: ivfail=0
121: ivdele=0
122: iczero=0
123: c
124: c write page headers
125: write (i02,90000)
126: write (i02,90001)
127: write (i02,90002)
128: write (i02, 90002)
129: write (i02,90003)
130: write (i02,90002)
131: write (i02,90004)
132: write (i02,90002)
133: write (i02,90011)
134: write (i02,90002)
135: write (i02,90002)
136: write (i02,90005)
137: write (i02,90006)
138: write (i02,90002)
139: ivtnum = 553
140: c
141: c **** test 553 ****
142: c test 553 - the value of the integer function is set to a
143: c constant of 32767 regardless of the value of the arguement
144: c supplied to the dummy arguement. test of positive integer
145: c constants for a statement function.
146: c
147: c
148: if (iczero) 35530, 5530, 35530
149: 5530 continue
150: ivcomp = ifon01(3)
151: go to 45530
152: 35530 ivdele = ivdele + 1
153: write (i02,80003) ivtnum
154: if (iczero) 45530, 5541, 45530
155: 45530 if ( ivcomp - 32767 ) 25530, 15530, 25530
156: 15530 ivpass = ivpass + 1
157: write (i02,80001) ivtnum
158: go to 5541
159: 25530 ivfail = ivfail + 1
160: ivcorr = 32767
161: write (i02,80004) ivtnum, ivcomp ,ivcorr
162: 5541 continue
163: ivtnum = 554
164: c
165: c **** test 554 ****
166: c test 554 - test of the statement function of type logical
167: c set to the logical constant .true. regardless of the
168: c arguement supplied to the dummy arguement.
169: c a logical if statement is used in conjunction with the logical
170: c statement function. the true path is tested.
171: c
172: c
173: if (iczero) 35540, 5540, 35540
174: 5540 continue
175: ivon01 = 0
176: if ( lftn01(.false.) ) ivon01 = 1
177: go to 45540
178: 35540 ivdele = ivdele + 1
179: write (i02,80003) ivtnum
180: if (iczero) 45540, 5551, 45540
181: 45540 if ( ivon01 - 1 ) 25540, 15540, 25540
182: 15540 ivpass = ivpass + 1
183: write (i02,80001) ivtnum
184: go to 5551
185: 25540 ivfail = ivfail + 1
186: ivcomp = ivon01
187: ivcorr = 1
188: write (i02,80004) ivtnum, ivcomp ,ivcorr
189: 5551 continue
190: ivtnum = 555
191: c
192: c **** test 555 ****
193: c test 555 - the integer statement function is set to the value
194: c of the argeument supplied.
195: c
196: c
197: if (iczero) 35550, 5550, 35550
198: 5550 continue
199: ivcomp = ifon02 ( 32767 )
200: go to 45550
201: 35550 ivdele = ivdele + 1
202: write (i02,80003) ivtnum
203: if (iczero) 45550, 5561, 45550
204: 45550 if ( ivcomp - 32767 ) 25550, 15550, 25550
205: 15550 ivpass = ivpass + 1
206: write (i02,80001) ivtnum
207: go to 5561
208: 25550 ivfail = ivfail + 1
209: ivcorr = 32767
210: write (i02,80004) ivtnum, ivcomp ,ivcorr
211: 5561 continue
212: ivtnum = 556
213: c
214: c **** test 556 ****
215: c test 556 - test of a logical statement function set to the
216: c value of the arguement supplied. the false path of a logical
217: c if statement is used in conjunction with the logical
218: c statement function.
219: c
220: c
221: if (iczero) 35560, 5560, 35560
222: 5560 continue
223: ivon01 = 1
224: if ( lftn02(.false.) ) ivon01 = 0
225: go to 45560
226: 35560 ivdele = ivdele + 1
227: write (i02,80003) ivtnum
228: if (iczero) 45560, 5571, 45560
229: 45560 if ( ivon01 - 1 ) 25560, 15560, 25560
230: 15560 ivpass = ivpass + 1
231: write (i02,80001) ivtnum
232: go to 5571
233: 25560 ivfail = ivfail + 1
234: ivcomp = ivon01
235: ivcorr = 1
236: write (i02,80004) ivtnum, ivcomp ,ivcorr
237: 5571 continue
238: ivtnum = 557
239: c
240: c **** test 557 ****
241: c test 557 - the value of an integer function is set equal to
242: c value of the arguement supplied. this value is an integer
243: c variable set to 32767.
244: c
245: c
246: if (iczero) 35570, 5570, 35570
247: 5570 continue
248: icon01 = 32767
249: ivcomp = ifon03 ( icon01 )
250: go to 45570
251: 35570 ivdele = ivdele + 1
252: write (i02,80003) ivtnum
253: if (iczero) 45570, 5581, 45570
254: 45570 if ( ivcomp - 32767 ) 25570, 15570, 25570
255: 15570 ivpass = ivpass + 1
256: write (i02,80001) ivtnum
257: go to 5581
258: 25570 ivfail = ivfail + 1
259: ivcorr = 32767
260: write (i02,80004) ivtnum, ivcomp ,ivcorr
261: 5581 continue
262: ivtnum = 558
263: c
264: c **** test 558 ****
265: c test 558 - a logical statement function is set equal to the
266: c value of the arguement supplied. this value is a logical
267: c variable set to .true. the true path of a logical if
268: c statement is used in conjunction with the logical statement
269: c function.
270: c
271: c
272: if (iczero) 35580, 5580, 35580
273: 5580 continue
274: ivon01 = 0
275: lctn03 = .true.
276: if ( lftn03(lctn03) ) ivon01 = 1
277: go to 45580
278: 35580 ivdele = ivdele + 1
279: write (i02,80003) ivtnum
280: if (iczero) 45580, 5591, 45580
281: 45580 if ( ivon01 - 1 ) 25580, 15580, 25580
282: 15580 ivpass = ivpass + 1
283: write (i02,80001) ivtnum
284: go to 5591
285: 25580 ivfail = ivfail + 1
286: ivcomp = ivon01
287: ivcorr = 1
288: write (i02,80004) ivtnum, ivcomp ,ivcorr
289: 5591 continue
290: ivtnum = 559
291: c
292: c **** test 559 ****
293: c test 559 - like test 558 only the logical .not. is used
294: c in the logical statement function definition the false path
295: c of a logical if statement is used in conjunction with the
296: c logical statement function.
297: c
298: c
299: if (iczero) 35590, 5590, 35590
300: 5590 continue
301: ivon01 = 1
302: lctn04 = .true.
303: if ( lftn04(lctn04) ) ivon01 = 0
304: go to 45590
305: 35590 ivdele = ivdele + 1
306: write (i02,80003) ivtnum
307: if (iczero) 45590, 5601, 45590
308: 45590 if ( ivon01 - 1 ) 25590, 15590, 25590
309: 15590 ivpass = ivpass + 1
310: write (i02,80001) ivtnum
311: go to 5601
312: 25590 ivfail = ivfail + 1
313: ivcomp = ivon01
314: ivcorr = 1
315: write (i02,80004) ivtnum, ivcomp ,ivcorr
316: 5601 continue
317: ivtnum = 560
318: c
319: c **** test 560 ****
320: c test 560 - integer exponientiation used in an integer
321: c statement function.
322: c
323: c
324: if (iczero) 35600, 5600, 35600
325: 5600 continue
326: icon04 = 3
327: ivcomp = ifon04(icon04)
328: go to 45600
329: 35600 ivdele = ivdele + 1
330: write (i02,80003) ivtnum
331: if (iczero) 45600, 5611, 45600
332: 45600 if ( ivcomp - 9 ) 25600, 15600, 25600
333: 15600 ivpass = ivpass + 1
334: write (i02,80001) ivtnum
335: go to 5611
336: 25600 ivfail = ivfail + 1
337: ivcorr = 9
338: write (i02,80004) ivtnum, ivcomp ,ivcorr
339: 5611 continue
340: ivtnum = 561
341: c
342: c **** test 561 ****
343: c test 561 - test of integer addition using two (2) dummy
344: c arguements.
345: c
346: c
347: if (iczero) 35610, 5610, 35610
348: 5610 continue
349: icon05 = 9
350: icon06 = 16
351: ivcomp = ifon05(icon05, icon06)
352: go to 45610
353: 35610 ivdele = ivdele + 1
354: write (i02,80003) ivtnum
355: if (iczero) 45610, 5621, 45610
356: 45610 if ( ivcomp - 25 ) 25610, 15610, 25610
357: 15610 ivpass = ivpass + 1
358: write (i02,80001) ivtnum
359: go to 5621
360: 25610 ivfail = ivfail + 1
361: ivcorr = 25
362: write (i02,80004) ivtnum, ivcomp ,ivcorr
363: 5621 continue
364: ivtnum = 562
365: c
366: c **** test 562 ****
367: c test 562 - this test is the solution of a right triangle
368: c using integer statement functions which reference the
369: c intrinsic functions sqrt and float. this is a 3-4-5
370: c right triangle.
371: c
372: c
373: if (iczero) 35620, 5620, 35620
374: 5620 continue
375: icon07 = 3
376: icon08 = 4
377: ivcomp = ifon06(icon07, icon08)
378: go to 45620
379: 35620 ivdele = ivdele + 1
380: write (i02,80003) ivtnum
381: if (iczero) 45620, 5631, 45620
382: 45620 if ( ivcomp - 5 ) 5622, 15620, 5622
383: 5622 if ( ivcomp - 4 ) 25620, 15620, 25620
384: 15620 ivpass = ivpass + 1
385: write (i02,80001) ivtnum
386: go to 5631
387: 25620 ivfail = ivfail + 1
388: ivcorr = 5
389: write (i02,80004) ivtnum, ivcomp ,ivcorr
390: 5631 continue
391: ivtnum = 563
392: c
393: c **** test 563 ****
394: c test 563 - solution of a 3-4-5 right triangle like test 562
395: c except that both intrinsic and previously defined statement
396: c functions are used.
397: c
398: c
399: if (iczero) 35630, 5630, 35630
400: 5630 continue
401: icon09 = 3
402: icon10 = 4
403: ivcomp = ifon08(icon09, icon10)
404: go to 45630
405: 35630 ivdele = ivdele + 1
406: write (i02,80003) ivtnum
407: if (iczero) 45630, 5641, 45630
408: 45630 if ( ivcomp - 5 ) 5632, 15630, 5632
409: 5632 if ( ivcomp - 4 ) 25630, 15630, 25630
410: 15630 ivpass = ivpass + 1
411: write (i02,80001) ivtnum
412: go to 5641
413: 25630 ivfail = ivfail + 1
414: ivcorr = 5
415: write (i02,80004) ivtnum, ivcomp ,ivcorr
416: 5641 continue
417: ivtnum = 564
418: c
419: c **** test 564 ****
420: c test 564 - use of array elements in an integer statement
421: c function which uses the operations of + - * / .
422: c
423: c
424: if (iczero) 35640, 5640, 35640
425: 5640 continue
426: iadn11(1) = 2
427: iadn11(2) = 2
428: ivcomp = ifon09( iadn11(1), iadn11(2) )
429: go to 45640
430: 35640 ivdele = ivdele + 1
431: write (i02,80003) ivtnum
432: if (iczero) 45640, 5651, 45640
433: 45640 if ( ivcomp - 1 ) 25640, 15640, 25640
434: 15640 ivpass = ivpass + 1
435: write (i02,80001) ivtnum
436: go to 5651
437: 25640 ivfail = ivfail + 1
438: ivcorr = 1
439: write (i02,80004) ivtnum, ivcomp ,ivcorr
440: 5651 continue
441: c
442: c write page footings and run summaries
443: 99999 continue
444: write (i02,90002)
445: write (i02,90006)
446: write (i02,90002)
447: write (i02,90002)
448: write (i02,90007)
449: write (i02,90002)
450: write (i02,90008) ivfail
451: write (i02,90009) ivpass
452: write (i02,90010) ivdele
453: c
454: c
455: c terminate routine execution
456: stop
457: c
458: c format statements for page headers
459: 90000 format (1h1)
460: 90002 format (1h )
461: 90001 format (1h ,10x,34hfortran compiler validation system)
462: 90003 format (1h ,21x,11hversion 1.0)
463: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
464: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
465: 90006 format (1h ,5x,46h----------------------------------------------)
466: 90011 format (1h ,18x,17hsubset level test)
467: c
468: c format statements for run summaries
469: 90008 format (1h ,15x,i5,19h errors encountered)
470: 90009 format (1h ,15x,i5,13h tests passed)
471: 90010 format (1h ,15x,i5,14h tests deleted)
472: c
473: c format statements for test results
474: 80001 format (1h ,4x,i5,7x,4hpass)
475: 80002 format (1h ,4x,i5,7x,4hfail)
476: 80003 format (1h ,4x,i5,7x,7hdeleted)
477: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
478: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
479: c
480: 90007 format (1h ,20x,20hend of program fm020)
481: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.