![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm080.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 fm080.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 fm080
4: c
5: c this routine contains external function reference tests.
6: c the function subprograms called by this routine are ff081,
7: c ff082 and ff083. the function subprograms are defined as
8: c ff081 = integer, ff082 = real, ff083 = implicit real.
9: c the function subprogram dummy arguments must agree in order,
10: c number and type with the corresponding actual arguments of the
11: c main program. the arguments of the function subprograms will
12: c correspond to actual argument list references of variable-name,
13: c array-name, array-element-name and expression respectively.
14: c
15: c this routine will test the value of the function and the
16: c function arguments returned following the function reference call.
17: c
18: c
19: c references
20: c american national standard programming language fortran,
21: c x3.9-1978
22: c
23: c section 2.6, array
24: c section 15.5.2, referencing external functions
25: c section 17.2, events that cause entities to become defined
26: dimension iadn1a (5), iadn2a (4,4)
27: dimension radn3a (3,6,3), radn1a (10)
28: dimension iadn3a (3,4,5)
29: integer ff081
30: real ff082
31: c
32: c **********************************************************
33: c
34: c a compiler validation system for the fortran language
35: c based on specifications as defined in american national standard
36: c programming language fortran x3.9-1978, has been developed by the
37: c federal cobol compiler testing service. the fortran compiler
38: c validation system (fcvs) consists of audit routines, their related
39: c data, and an executive system. each audit routine is a fortran
40: c program, subprogram or function which includes tests of specific
41: c language elements and supporting procedures indicating the result
42: c of executing these tests.
43: c
44: c this particular program/subprogram/function contains features
45: c found only in the subset as defined in x3.9-1978.
46: c
47: c suggestions and comments should be forwarded to -
48: c
49: c department of the navy
50: c federal cobol compiler testing service
51: c washington, d.c. 20376
52: c
53: c **********************************************************
54: c
55: c
56: c
57: c initialization section
58: c
59: c initialize constants
60: c **************
61: c i01 contains the logical unit number for the card reader.
62: i01 = 5
63: c i02 contains the logical unit number for the printer.
64: i02 = 6
65: c system environment section
66: c
67: cx010 this card is replaced by contents of fexec x-010 control card.
68: c the cx010 card is for overriding the program default i01 = 5
69: c (unit number for card reader).
70: cx011 this card is replaced by contents of fexec x-011 control card.
71: c the cx011 card is for systems which require additional
72: c fortran statements for files associated with cx010 above.
73: c
74: cx020 this card is replaced by contents of fexec x-020 control card.
75: c the cx020 card is for overriding the program default i02 = 6
76: c (unit number for printer).
77: cx021 this card is replaced by contents of fexec x-021 control card.
78: c the cx021 card is for systems which require additional
79: c fortran statements for files associated with cx020 above.
80: c
81: ivpass=0
82: ivfail=0
83: ivdele=0
84: iczero=0
85: c
86: c write page headers
87: write (i02,90000)
88: write (i02,90001)
89: write (i02,90002)
90: write (i02, 90002)
91: write (i02,90003)
92: write (i02,90002)
93: write (i02,90004)
94: write (i02,90002)
95: write (i02,90011)
96: write (i02,90002)
97: write (i02,90002)
98: write (i02,90005)
99: write (i02,90006)
100: write (i02,90002)
101: c
102: c test section
103: c
104: c external function reference - function subprogram defined as
105: c integer (ff081)
106: c
107: 6741 continue
108: ivtnum = 674
109: c
110: c test 674 through 679 test the function and argument values
111: c from reference of function ff081. function subprogram ff081 is
112: c defined as integer.
113: c
114: c **** test 674 ****
115: c
116: c test 674 tests the function value returned from function ff081
117: c
118: if (iczero) 36740,6740,36740
119: 6740 continue
120: ivon0a = 0
121: ivon02 = 2
122: iadn1a (3) = 8
123: iadn1a (2) = 4
124: iadn2a (1,3) =10
125: ivon0a = ff081 (ivon02, iadn1a, iadn2a, 999)
126: go to 46740
127: 36740 ivdele = ivdele + 1
128: write (i02,80003) ivtnum
129: if (iczero) 46740,6751,46740
130: 46740 if (ivon0a - 1015) 26740,16740,26740
131: 16740 ivpass = ivpass + 1
132: write (i02,80001) ivtnum
133: go to 6751
134: 26740 ivfail = ivfail + 1
135: ivcorr = 1015
136: ivcomp = ivon0a
137: write (i02,80004) ivtnum, ivcomp, ivcorr
138: 6751 continue
139: ivtnum = 675
140: c
141: c **** test 675 ****
142: c
143: c test 675 tests the return value of variable-name argument
144: c ivon02. value of ivon02 should be 4.
145: c
146: if (iczero) 36750,6750,36750
147: 6750 continue
148: go to 46750
149: 36750 ivdele = ivdele + 1
150: write (i02,80003) ivtnum
151: if (iczero) 46750,6761,46750
152: 46750 if (ivon02 - 4) 26750,16750,26750
153: 16750 ivpass = ivpass + 1
154: write (i02,80001) ivtnum
155: go to 6761
156: 26750 ivfail = ivfail + 1
157: ivcorr = 4
158: ivcomp = ivon02
159: write (i02,80004) ivtnum, ivcomp, ivcorr
160: 6761 continue
161: ivtnum = 676
162: c
163: c **** test 676 ****
164: c
165: c test 676 tests the return value of array-name argument
166: c iadn1a. iadn1a (2) is incremented by 40 in function subprogram
167: c and should return a value of 44.
168: c
169: if (iczero) 36760,6760,36760
170: 6760 continue
171: go to 46760
172: 36760 ivdele = ivdele + 1
173: write (i02,80003) ivtnum
174: if (iczero) 46760,6771,46760
175: 46760 if (iadn1a (2) - 44) 26760,16760,26760
176: 16760 ivpass = ivpass + 1
177: write (i02,80001) ivtnum
178: go to 6771
179: 26760 ivfail = ivfail + 1
180: ivcorr = 44
181: ivcomp = iadn1a (2)
182: write (i02,80004) ivtnum, ivcomp, ivcorr
183: 6771 continue
184: ivtnum = 677
185: c
186: c **** test 677 ****
187: c
188: c test 677 tests the return value of array-name argument iadn1a.
189: c iadn1a (3) was not modiffed by function subprogram and should
190: c have a value of 8
191: c
192: if (iczero) 36770,6770,36770
193: 6770 continue
194: go to 46770
195: 36770 ivdele = ivdele + 1
196: write (i02,80003) ivtnum
197: if (iczero) 46770,6781,46770
198: 46770 if (iadn1a (3) - 8) 26770,16770,26770
199: 16770 ivpass = ivpass + 1
200: write (i02,80001) ivtnum
201: go to 6781
202: 26770 ivfail = ivfail + 1
203: ivcorr = 8
204: ivcomp = iadn1a (3)
205: write (i02,80004) ivtnum, ivcomp, ivcorr
206: 6781 continue
207: ivtnum = 678
208: c
209: c **** test 678 ****
210: c
211: c test 678 tests the return value of array-element-name
212: c iadn2a (1,3). iadn2a (1,3) was incremented by 70 in the function
213: c subprogram and should contain a value of 80.
214: c
215: if (iczero) 36780,6780,36780
216: 6780 continue
217: go to 46780
218: 36780 ivdele = ivdele + 1
219: write (i02,80003) ivtnum
220: if (iczero) 46780,6791,46780
221: 46780 if (iadn2a (1,3) - 80) 26780,16780,26780
222: 16780 ivpass = ivpass + 1
223: write (i02,80001) ivtnum
224: go to 6791
225: 26780 ivfail = ivfail + 1
226: ivcorr = 80
227: ivcomp = iadn2a (1,3)
228: write (i02,80004) ivtnum, ivcomp, ivcorr
229: 6791 continue
230: ivtnum = 679
231: c
232: c **** test 679 ****
233: c
234: c test 679 tests the value of integer function assigned
235: c to a real variable.
236: c
237: if (iczero) 36790,6790,36790
238: 6790 continue
239: rvon0a = 0.0
240: ivon02 = 2
241: iadn1a (2) = 4
242: iadn2a (1,3) = 10
243: rvon0a = ff081 (ivon02, iadn1a, iadn2a, 999)
244: go to 46790
245: 36790 ivdele = ivdele + 1
246: write (i02,80003) ivtnum
247: if (iczero) 46790,6801,46790
248: 46790 if (rvon0a - 1014.5) 26790,16790,46791
249: 46791 if (rvon0a - 1015.5) 16790,16790,26790
250: 16790 ivpass = ivpass + 1
251: write (i02,80001) ivtnum
252: go to 6801
253: 26790 ivfail = ivfail + 1
254: rvcorr = 1015.0
255: rvcomp = rvon0a
256: write (i02,80005) ivtnum, rvcomp, rvcorr
257: 6801 continue
258: ivtnum = 680
259: c
260: c external function reference - function subprogram ff082 defined as
261: c real
262: c
263: c tests 680 thru 685 tests the function and argument values
264: c from the function reference to subprogram ff082. the function
265: c subprogram is defined as real.
266: c
267: c **** test 680 ***
268: c
269: c test 680 tests the value of the function ff082. value of
270: c function should be 339.0.
271: c
272: if (iczero) 36800,6800,36800
273: 6800 continue
274: rvon01 = 2.0
275: radn3a (2,5,2) = 100.0
276: radn1a (5) = 210.5
277: rvon0a = 0.0
278: rvon0a = ff082 (rvon01, radn3a, radn1a, 26.5)
279: go to 46800
280: 36800 ivdele = ivdele + 1
281: write (i02, 80003) ivtnum
282: if (iczero) 46800,6811,46800
283: 46800 if (rvon0a - 338.5) 26800,16800,46801
284: 46801 if (rvon0a - 339.5) 16800,16800,26800
285: 16800 ivpass = ivpass + 1
286: write (i02,80001) ivtnum
287: go to 6811
288: 26800 ivfail = ivfail + 1
289: rvcorr = 339.0
290: rvcomp = rvon0a
291: write (i02,80005) ivtnum, rvcomp, rvcorr
292: 6811 continue
293: ivtnum = 681
294: c
295: c **** test 681 ****
296: c
297: c test 681 tests the value of the variable-name argument rvon01
298: c following the function reference. value of rvon01 should be 8.4.
299: c
300: if (iczero) 36810,6810,36810
301: 6810 continue
302: go to 46810
303: 36810 ivdele = ivdele + 1
304: write (i02,80003) ivtnum
305: if (iczero) 46810,6821,46810
306: 46810 if (rvon01 - 8.395) 26810,16810,46811
307: 46811 if (rvon01 - 8.405) 16810,16810,26810
308: 16810 ivpass = ivpass + 1
309: write (i02,80001) ivtnum
310: go to 6821
311: 26810 ivfail = ivfail + 1
312: rvcorr = 8.4
313: rvcomp = rvon01
314: write (i02,80005) ivtnum, rvcomp, rvcorr
315: 6821 continue
316: ivtnum = 682
317: c
318: c **** test 682 ****
319: c
320: c test 682 tests the value of the array-name argument radn3a
321: c following the function reference. radn3a (2,5,2) was initialized
322: c in main program and incremented in subprogram. value of radn3a
323: c (2,5,2) should be 112.2.
324: c
325: if (iczero) 36820,6820,36820
326: 6820 continue
327: go to 46820
328: 36820 ivdele = ivdele + 1
329: write (i02,80003) ivtnum
330: if (iczero) 46820,6831,46820
331: 46820 if (radn3a (2,5,2) - 111.7) 26820,16820,46821
332: 46821 if (radn3a (2,5,2) - 112.7) 16820,16820,26820
333: 16820 ivpass = ivpass + 1
334: write (i02,80001) ivtnum
335: go to 6831
336: 26820 ivfail = ivfail + 1
337: rvcorr = 112.2
338: rvcomp = radn3a (2,5,2)
339: write (i02,80005) ivtnum, rvcomp, rvcorr
340: 6831 continue
341: ivtnum = 683
342: c
343: c **** test 683 ****
344: c
345: c test 683 tests the value of the array-name argument radn3a
346: c following the function reference. radn3a (1,2,1) was initialized
347: c in the subprogram. the value of radn3a (1,2,1) should be 612.2.
348: c
349: if (iczero) 36830,6830,36830
350: 6830 continue
351: go to 46830
352: 36830 ivdele = ivdele + 1
353: write (i02,80003) ivtnum
354: if (iczero) 46830,6841,46830
355: 46830 if (radn3a (1,2,1) - 611.7) 26830,16830,46831
356: 46831 if (radn3a (1,2,1) - 612.7) 16830,16830,26830
357: 16830 ivpass = ivpass + 1
358: write (i02,80001) ivtnum
359: go to 6841
360: 26830 ivfail = ivfail + 1
361: rvcorr = 612.2
362: rvcomp = radn3a (1,2,1)
363: write (i02,80005) ivtnum, rvcomp, rvcorr
364: 6841 continue
365: ivtnum = 684
366: c
367: c **** test 684 ****
368: c
369: c test 684 tests the value of the array-element-name argument
370: c radn1a following the function reference. radn1a (5) was
371: c initialized in the main program and incremented by 18.8 in the
372: c function subprogram. the value of radn1a should be 229.3.
373: c
374: if (iczero) 36840,6840,36840
375: 6840 continue
376: go to 46840
377: 36840 ivdele = ivdele + 1
378: write (i02,80003) ivtnum
379: if (iczero) 46840,6851,46840
380: 46840 if (radn1a (5) - 228.8) 26840,16840,46841
381: 46841 if (radn1a (5) - 229.8) 16840,16840,26840
382: 16840 ivpass = ivpass + 1
383: write (i02,80001) ivtnum
384: go to 6851
385: 26840 ivfail = ivfail + 1
386: rvcorr = 229.3
387: rvcomp = radn1a (5)
388: write (i02,80005) ivtnum, rvcomp, rvcorr
389: 6851 continue
390: ivtnum = 685
391: c
392: c **** test 685 ****
393: c
394: c test 685 tests the resultant value where the function
395: c subprogram is defined as real and the variable to which the
396: c function value is assigned in the main program is defined as
397: c integer.
398: c
399: if (iczero) 36850,6850,36850
400: 6850 continue
401: rvon01 = 4.0
402: radn3a (2,5,2) = 200.0
403: radn1a (5) = 2.85
404: ivon0a = 0.0
405: ivon0a = ff082 (rvon01, radn3a, radn1a, 102.68)
406: go to 46850
407: 36850 ivdele = ivdele + 1
408: write (i02,80003) ivtnum
409: if (iczero) 46850,6861,46850
410: 46850 if (ivon0a - 309) 26850,16850,26850
411: 16850 ivpass = ivpass + 1
412: write (i02,80001) ivtnum
413: go to 6861
414: 26850 ivfail = ivfail + 1
415: ivcorr = 309
416: ivcomp = ivon0a
417: write (i02,80004) ivtnum, ivcomp, ivcorr
418: 6861 continue
419: ivtnum = 686
420: c
421: c tests 686 thru 690 tests the function and argument values
422: c from the external function reference to subprogram ff083. the
423: c function subprogram is an implicit definition of real.
424: c
425: c ***** test 686 *****
426: c
427: c test 686 tests the value of function ff082. the value of the
428: c function should be 921.8.
429: c
430: if (iczero) 36860,6860,36860
431: 6860 continue
432: c
433: c
434: ivon01 = 826
435: iadn2a (1,1) = 77
436: iadn3a (2,3,4) = 10
437: rvon02 = 4.4
438: rvon03 = 0.0
439: c
440: rvon03 = ff083 (ivon01, iadn2a, iadn3a, rvon02 * 2.0)
441: go to 46860
442: 36860 ivdele = ivdele + 1
443: write (i02,80003) ivtnum
444: if (iczero) 46860,6871,46860
445: 46860 if (rvon03 - 921.3) 26860,16860,46861
446: 46861 if (rvon03 - 922.3) 16860,16860,26860
447: 16860 ivpass = ivpass + 1
448: write (i02,80001) ivtnum
449: go to 6871
450: 26860 ivfail = ivfail + 1
451: rvcorr = 921.8
452: rvcomp = rvon03
453: write (i02,80005) ivtnum, rvcomp, ivcorr
454: 6871 continue
455: ivtnum = 687
456: c
457: c **** test 687 *****
458: c
459: c test 687 tests the value of the variable-name argument ivon01
460: c following the function reference. the value of ivon01 should be
461: c 836.
462: c
463: if (iczero) 36870,6870,36870
464: 6870 continue
465: go to 46870
466: 36870 ivdele = ivdele + 1
467: write (i02,80003) ivtnum
468: if (iczero) 46870,6881,46870
469: 46870 if (ivon01 - 836) 26870,16870,26870
470: 16870 ivpass = ivpass + 1
471: write (i02,80001) ivtnum
472: go to 6881
473: 26870 ivfail = ivfail + 1
474: ivcorr = 836
475: ivcomp = ivon01
476: write (i02,80004) ivtnum, ivcomp, ivcorr
477: 6881 continue
478: ivtnum = 688
479: c
480: c **** test 688 *****
481: c
482: c test 688 tests the value of the array-name argument iadn2a
483: c following the function reference. the actual argument was
484: c initialized in the main program and is incremented in the
485: c subprogram. the value of iadn2a (1,1) should be 97.
486: c
487: if (iczero) 36880,6880,36880
488: 6880 continue
489: go to 46880
490: 36880 ivdele = ivdele + 1
491: write (i02,80003) ivtnum
492: if (iczero) 46880,6880,46880
493: 46880 if (iadn2a (1,1) - 97) 26880,16880,26880
494: 16880 ivpass = ivpass + 1
495: write (i02,80001) ivtnum
496: go to 6891
497: 26880 ivfail = ivfail + 1
498: ivcorr = 97
499: ivcomp = iadn2a (1,1)
500: write (i02,80004) ivtnum, ivcomp, ivcorr
501: 6891 continue
502: ivtnum = 689
503: c
504: c **** test 689 ****
505: c
506: c test 689 tests the value of the array-element-name argument
507: c iadn3a following the function reference. iadn3a (2,3,4)
508: c was intialized in the main program and incremented by 40 in the
509: c function subprogram. the value of iadn3a should be 50.
510: c
511: if (iczero) 36890,6890,36890
512: 6890 continue
513: go to 46890
514: 36890 ivdele = ivdele + 1
515: write (i02,80003) ivtnum
516: if (iczero) 46890,6901,46890
517: 46890 if (iadn3a (2,3,4) - 50) 26890,16890,26890
518: 16890 ivpass = ivpass + 1
519: write (i02,80001) ivtnum
520: go to 6901
521: 26890 ivfail = ivfail + 1
522: ivcorr = 50
523: ivcomp = iadn3a (2,3,4)
524: write (i02,80004) ivtnum,ivcomp,ivcorr
525: 6901 continue
526: ivtnum = 690
527: c
528: c **** test 690 ****
529: c
530: c test 690 tests the resultant value where the function
531: c subprogram is implicity defined as real and the variable
532: c to which the function value is assigned in the main program
533: c is defined as integer. the value of ivon03 should be 329.
534: c
535: if (iczero) 36900,6900,36900
536: 6900 continue
537: ivon01 = 226
538: iadn2a (1,1) = 66
539: iadn3a (2,3,4) = 20
540: rvon02 = 8.8
541: ivon03 = 0
542: c
543: ivon03 = ff083 (ivon01,iadn2a,iadn3a,rvon02 * 2.0)
544: c
545: go to 46900
546: 36900 ivdele = ivdele + 1
547: write (i02,80003) ivtnum
548: if (iczero) 46900,6911,46900
549: 46900 if (ivon03 - 329) 26900,16900,26900
550: 16900 ivpass = ivpass + 1
551: write (i02,80001) ivtnum
552: go to 6911
553: 26900 ivfail = ivfail + 1
554: ivcorr = 329
555: ivcomp = ivon03
556: write (i02,80004) ivtnum, ivcomp, ivcorr
557: 6911 continue
558: c
559: c write page footings and run summaries
560: 99999 continue
561: write (i02,90002)
562: write (i02,90006)
563: write (i02,90002)
564: write (i02,90002)
565: write (i02,90007)
566: write (i02,90002)
567: write (i02,90008) ivfail
568: write (i02,90009) ivpass
569: write (i02,90010) ivdele
570: c
571: c
572: c terminate routine execution
573: stop
574: c
575: c format statements for page headers
576: 90000 format (1h1)
577: 90002 format (1h )
578: 90001 format (1h ,10x,34hfortran compiler validation system)
579: 90003 format (1h ,21x,11hversion 1.0)
580: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
581: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
582: 90006 format (1h ,5x,46h----------------------------------------------)
583: 90011 format (1h ,18x,17hsubset level test)
584: c
585: c format statements for run summaries
586: 90008 format (1h ,15x,i5,19h errors encountered)
587: 90009 format (1h ,15x,i5,13h tests passed)
588: 90010 format (1h ,15x,i5,14h tests deleted)
589: c
590: c format statements for test results
591: 80001 format (1h ,4x,i5,7x,4hpass)
592: 80002 format (1h ,4x,i5,7x,4hfail)
593: 80003 format (1h ,4x,i5,7x,7hdeleted)
594: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
595: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
596: c
597: 90007 format (1h ,20x,20hend of program fm080)
598: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.