![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm097.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 fm097.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 fm097
4: c
5: c this routine tests intrinsic functions where the function type is
6: c real and the arguments are either integer or real. the real and
7: c integer variables and the real and integer constants contain both
8: c positive and negative values. the intrinsic functions tested by
9: c fm097 include
10: c type of
11: c intrinsic function name argument function
12: c ------------------ ---- -------- --------
13: c absolute value abs real real
14: c truncation aint real real
15: c remaindering amod real real
16: c choosing largest value amax0 integer real
17: c amax1 real real
18: c choosing smallest value amin0 integer real
19: c amin1 real real
20: c float float integer real
21: c transfer of sign sign real real
22: c positive difference dim real real
23: c
24: c references
25: c american national standard programming language fortran,
26: c x3.9-1978
27: c
28: c section 4.1.2, type rules for data and procedure identifiers
29: c section 15.3, intrinsic function
30: c section 15.3.2, intrinsic functions and their reference
31: c
32: c
33: c **********************************************************
34: c
35: c a compiler validation system for the fortran language
36: c based on specifications as defined in american national standard
37: c programming language fortran x3.9-1978, has been developed by the
38: c federal cobol compiler testing service. the fortran compiler
39: c validation system (fcvs) consists of audit routines, their related
40: c data, and an executive system. each audit routine is a fortran
41: c program, subprogram or function which includes tests of specific
42: c language elements and supporting procedures indicating the result
43: c of executing these tests.
44: c
45: c this particular program/subprogram/function contains features
46: c found only in the subset as defined in x3.9-1978.
47: c
48: c suggestions and comments should be forwarded to -
49: c
50: c department of the navy
51: c federal cobol compiler testing service
52: c washington, d.c. 20376
53: c
54: c **********************************************************
55: c
56: c
57: c
58: c initialization section
59: c
60: c initialize constants
61: c **************
62: c i01 contains the logical unit number for the card reader.
63: i01 = 5
64: c i02 contains the logical unit number for the printer.
65: i02 = 6
66: c system environment section
67: c
68: cx010 this card is replaced by contents of fexec x-010 control card.
69: c the cx010 card is for overriding the program default i01 = 5
70: c (unit number for card reader).
71: cx011 this card is replaced by contents of fexec x-011 control card.
72: c the cx011 card is for systems which require additional
73: c fortran statements for files associated with cx010 above.
74: c
75: cx020 this card is replaced by contents of fexec x-020 control card.
76: c the cx020 card is for overriding the program default i02 = 6
77: c (unit number for printer).
78: cx021 this card is replaced by contents of fexec x-021 control card.
79: c the cx021 card is for systems which require additional
80: c fortran statements for files associated with cx020 above.
81: c
82: ivpass=0
83: ivfail=0
84: ivdele=0
85: iczero=0
86: c
87: c write page headers
88: write (i02,90000)
89: write (i02,90001)
90: write (i02,90002)
91: write (i02, 90002)
92: write (i02,90003)
93: write (i02,90002)
94: write (i02,90004)
95: write (i02,90002)
96: write (i02,90011)
97: write (i02,90002)
98: write (i02,90002)
99: write (i02,90005)
100: write (i02,90006)
101: write (i02,90002)
102: c
103: c test section
104: c
105: c test 875 through test 878 contain intrinsic function tests for
106: c absolute value where argument and function are real
107: c
108: ivtnum = 875
109: c
110: c **** test 875 ****
111: c
112: if (iczero) 38750, 8750, 38750
113: 8750 continue
114: rvcomp = abs (-38.2)
115: go to 48750
116: 38750 ivdele = ivdele + 1
117: write (i02,80003) ivtnum
118: if (iczero) 48750, 8761, 48750
119: 48750 if (rvcomp - 38.195) 28750,18750,48751
120: 48751 if (rvcomp - 38.205) 18750,18750,28750
121: 18750 ivpass = ivpass + 1
122: write (i02,80001) ivtnum
123: go to 8761
124: 28750 ivfail = ivfail + 1
125: rvcorr = 38.200
126: write (i02,80005) ivtnum, rvcomp, rvcorr
127: 8761 continue
128: ivtnum = 876
129: c
130: c **** test 876 ****
131: c
132: if (iczero) 38760, 8760, 38760
133: 8760 continue
134: rvon01 = 445.06
135: rvcomp = abs (rvon01)
136: go to 48760
137: 38760 ivdele = ivdele + 1
138: write (i02,80003) ivtnum
139: if (iczero) 48760, 8771, 48760
140: 48760 if (rvcomp - 445.01) 28760,18760,48761
141: 48761 if (rvcomp - 445.11) 18760,18760,28760
142: 18760 ivpass = ivpass + 1
143: write (i02,80001) ivtnum
144: go to 8771
145: 28760 ivfail = ivfail + 1
146: rvcorr = 445.06
147: write (i02,80005) ivtnum, rvcomp, rvcorr
148: 8771 continue
149: ivtnum = 877
150: c
151: c **** test 877 ****
152: c
153: if (iczero) 38770, 8770, 38770
154: 8770 continue
155: rvon01 = -32.176
156: rvcomp = abs (rvon01)
157: go to 48770
158: 38770 ivdele = ivdele + 1
159: write (i02,80003) ivtnum
160: if (iczero) 48770, 8781, 48770
161: 48770 if (rvcomp - 32.171) 28770,18770,48771
162: 48771 if (rvcomp - 32.181) 18770,18770,28770
163: 18770 ivpass = ivpass + 1
164: write (i02,80001) ivtnum
165: go to 8781
166: 28770 ivfail = ivfail + 1
167: rvcorr = 32.176
168: write (i02,80005) ivtnum, rvcomp, rvcorr
169: 8781 continue
170: ivtnum = 878
171: c
172: c **** test 878 ****
173: c
174: if (iczero) 38780, 8780, 38780
175: 8780 continue
176: rvon01 = -2.2e+2
177: rvcomp = abs (rvon01)
178: go to 48780
179: 38780 ivdele = ivdele + 1
180: write (i02,80003) ivtnum
181: if (iczero) 48780, 8791, 48780
182: 48780 if (rvcomp - 219.95) 28780,18780,48781
183: 48781 if (rvcomp - 220.05) 18780,18780,28780
184: 18780 ivpass = ivpass + 1
185: write (i02,80001) ivtnum
186: go to 8791
187: 28780 ivfail = ivfail + 1
188: rvcorr = 220.00
189: write (i02,80005) ivtnum, rvcomp, rvcorr
190: 8791 continue
191: ivtnum = 879
192: c
193: c **** test 879 ****
194: c
195: c test 879 through test 882 contain intrinsic function tests for
196: c truncation where argument and function are real
197: c
198: c
199: if (iczero) 38790, 8790, 38790
200: 8790 continue
201: rvcomp = aint (38.2)
202: go to 48790
203: 38790 ivdele = ivdele + 1
204: write (i02,80003) ivtnum
205: if (iczero) 48790, 8801, 48790
206: 48790 if (rvcomp - 37.995) 28790,18790,48791
207: 48791 if (rvcomp - 38.005) 18790,18790,28790
208: 18790 ivpass = ivpass + 1
209: write (i02,80001) ivtnum
210: go to 8801
211: 28790 ivfail = ivfail + 1
212: rvcorr = 38.000
213: write (i02,80005) ivtnum, rvcomp, rvcorr
214: 8801 continue
215: ivtnum = 880
216: c
217: c **** test 880 ****
218: c
219: if (iczero) 38800, 8800, 38800
220: 8800 continue
221: rvon01 = -445.95
222: rvcomp = aint (rvon01)
223: go to 48800
224: 38800 ivdele = ivdele + 1
225: write (i02,80003) ivtnum
226: if (iczero) 48800, 8811, 48800
227: 48800 if (rvcomp + 445.05) 28800,18800,48801
228: 48801 if (rvcomp + 444.95) 18800,18800,28800
229: 18800 ivpass = ivpass + 1
230: write (i02,80001) ivtnum
231: go to 8811
232: 28800 ivfail = ivfail + 1
233: rvcorr = -445.00
234: write (i02,80005) ivtnum, rvcomp, rvcorr
235: 8811 continue
236: ivtnum = 881
237: c
238: c **** test 881 ****
239: c
240: if (iczero) 38810, 8810, 38810
241: 8810 continue
242: rvon01 = 466.01
243: rvcomp = aint (rvon01)
244: go to 48810
245: 38810 ivdele = ivdele + 1
246: write (i02,80003) ivtnum
247: if (iczero) 48810, 8821, 48810
248: 48810 if (rvcomp - 465.95) 28810,18810,48811
249: 48811 if (rvcomp - 466.05) 18810,18810,28810
250: 18810 ivpass = ivpass + 1
251: write (i02,80001) ivtnum
252: go to 8821
253: 28810 ivfail = ivfail + 1
254: rvcomp = 466.00
255: write (i02,80005) ivtnum, rvcomp, rvcorr
256: 8821 continue
257: ivtnum = 882
258: c
259: c **** test 882 ****
260: c
261: if (iczero) 38820, 8820, 38820
262: 8820 continue
263: rvon01 = 382e-1
264: rvcomp = aint (rvon01)
265: go to 48820
266: 38820 ivdele = ivdele + 1
267: write (i02,80003) ivtnum
268: if (iczero) 48820, 8831, 48820
269: 48820 if (rvcomp - 37.995) 28820,18820,48821
270: 48821 if (rvcomp - 38.005) 18820,18820,28820
271: 18820 ivpass = ivpass + 1
272: write (i02,80001) ivtnum
273: go to 8831
274: 28820 ivfail = ivfail + 1
275: rvcorr = 38.000
276: write (i02,80005) ivtnum, rvcomp, rvcorr
277: 8831 continue
278: c
279: c test 883 through 886 contain intrinsic function tests for
280: c remaindering where argument and function are real
281: c
282: ivtnum = 883
283: c
284: c **** test 883 ****
285: c
286: if (iczero) 38830, 8830, 38830
287: 8830 continue
288: rvcomp = amod (42.0,19.0)
289: go to 48830
290: 38830 ivdele = ivdele + 1
291: write (i02,80003) ivtnum
292: if (iczero) 48830, 8841, 48830
293: 48830 if (rvcomp - 3.9995) 28830,18830,48831
294: 48831 if (rvcomp - 4.0005) 18830,18830,28830
295: 18830 ivpass = ivpass + 1
296: write (i02,80001) ivtnum
297: go to 8841
298: 28830 ivfail = ivfail + 1
299: rvcorr = 4.0000
300: write (i02,80005) ivtnum, rvcomp, rvcorr
301: 8841 continue
302: ivtnum = 884
303: c
304: c **** test 884 ****
305: c
306: if (iczero) 38840, 8840, 38840
307: 8840 continue
308: rvon01 = 16.27
309: rvon02 = 2.0
310: rvcomp = amod (rvon01,rvon02)
311: go to 48840
312: 38840 ivdele = ivdele + 1
313: write (i02,80003) ivtnum
314: if (iczero) 48840, 8851, 48840
315: 48840 if (rvcomp - .26995) 28840,18840,48841
316: 48841 if (rvcomp - .27005) 18840,18840,28840
317: 18840 ivpass = ivpass + 1
318: write (i02,80001) ivtnum
319: go to 8851
320: 28840 ivfail = ivfail + 1
321: rvcorr = .27000
322: write (i02,80005) ivtnum, rvcomp, rvcorr
323: 8851 continue
324: ivtnum = 885
325: c
326: c **** test 885 ****
327: c
328: if (iczero) 38850, 8850, 38850
329: 8850 continue
330: rvon01 = 225.0
331: rvon02 = 5.0e1
332: rvcomp = amod (rvon01,rvon02)
333: go to 48850
334: 38850 ivdele = ivdele + 1
335: write (i02,80003) ivtnum
336: if (iczero) 48850, 8861, 48850
337: 48850 if (rvcomp - 24.995) 28850,18850,48851
338: 48851 if (rvcomp - 25.005) 18850,18850,28850
339: 18850 ivpass = ivpass + 1
340: write (i02,80001) ivtnum
341: go to 8861
342: 28850 ivfail = ivfail + 1
343: rvcorr = 25.000
344: write (i02,80005) ivtnum, rvcomp, rvcorr
345: 8861 continue
346: ivtnum = 886
347: c
348: c **** test 886 ****
349: c
350: if (iczero) 38860, 8860, 38860
351: 8860 continue
352: rvon01 = -0.390e+2
353: rvon02 = 5e2
354: rvcomp = amod (rvon01,rvon02)
355: go to 48860
356: 38860 ivdele = ivdele + 1
357: write (i02,80003) ivtnum
358: if (iczero) 48860, 8871, 48860
359: 48860 if (rvcomp + 39.005) 28860,18860,48861
360: 48861 if (rvcomp + 38.995) 18860,18860,28860
361: 18860 ivpass = ivpass + 1
362: write (i02,80001) ivtnum
363: go to 8871
364: 28860 ivfail = ivfail + 1
365: rvcorr = -39.000
366: write (i02,80005) ivtnum, rvcomp, rvcorr
367: 8871 continue
368: c
369: c test 887 and 888 contain intrinsic function tests for choosing
370: c largest value where arguments are integer and function is real
371: c
372: ivtnum = 887
373: c
374: c **** test 887 ****
375: c
376: if (iczero) 38870, 8870, 38870
377: 8870 continue
378: ivon01 = 317
379: ivon02 = -99
380: ivon03 = 1
381: rvcomp = amax0 (263,ivon01,ivon02,ivon03)
382: go to 48870
383: 38870 ivdele = ivdele + 1
384: write (i02,80003) ivtnum
385: if (iczero) 48870, 8881, 48870
386: 48870 if (rvcomp - 316.95) 28870,18870,48871
387: 48871 if (rvcomp - 317.05) 18870,18870,28870
388: 18870 ivpass = ivpass + 1
389: write (i02,80001) ivtnum
390: go to 8881
391: 28870 ivfail = ivfail + 1
392: rvcorr = 317.00
393: write (i02,80005) ivtnum, rvcomp, rvcorr
394: 8881 continue
395: ivtnum = 888
396: c
397: c **** test 888 ****
398: c
399: if (iczero) 38880, 8880, 38880
400: 8880 continue
401: ivon01 = 2572
402: ivon02 = 2570
403: rvcomp = amax0 (ivon01,ivon02)
404: go to 48880
405: 38880 ivdele = ivdele + 1
406: write (i02,80003) ivtnum
407: if (iczero) 48880, 8891, 48880
408: 48880 if (rvcomp - 2571.5) 28880,18880,48881
409: 48881 if (rvcomp - 2572.5) 18880,18880,28880
410: 18880 ivpass = ivpass + 1
411: write (i02,80001) ivtnum
412: go to 8891
413: 28880 ivfail = ivfail + 1
414: rvcorr = 2572.0
415: write (i02,80005) ivtnum, rvcomp, rvcorr
416: 8891 continue
417: c
418: c test 889 and 890 contain intrinsic function tests for choosing
419: c largest value where the arguments and function are real
420: c
421: ivtnum = 889
422: c
423: c **** test 889 ****
424: c
425: if (iczero) 38890, 8890, 38890
426: 8890 continue
427: rvon01 = .326e+2
428: rvon02 = 22.075
429: rvon03 = 76e-1
430: rvcomp = amax1 (rvon01,rvon02,rvon03)
431: go to 48890
432: 38890 ivdele = ivdele + 1
433: write (i02,80003) ivtnum
434: if (iczero) 48890, 8901, 48890
435: 48890 if (rvcomp - 32.595) 28890,18890,48891
436: 48891 if (rvcomp - 32.605) 18890,18890,28890
437: 18890 ivpass = ivpass + 1
438: write (i02,80001) ivtnum
439: go to 8901
440: 28890 ivfail = ivfail + 1
441: rvcorr = 32.600
442: write (i02,80005) ivtnum, rvcomp, rvcorr
443: 8901 continue
444: ivtnum = 890
445: c
446: c **** test 890 ****
447: c
448: if (iczero) 38900, 8900, 38900
449: 8900 continue
450: rvon01 = -6.3e2
451: rvon02 = -21.0
452: rvcomp = amax1 (-463.3,rvon01,rvon02)
453: go to 48900
454: 38900 ivdele = ivdele + 1
455: write (i02,80003) ivtnum
456: if (iczero) 48900, 8911, 48900
457: 48900 if (rvcomp + 21.005) 28900,18900,48901
458: 48901 if (rvcomp + 20.995) 18900,18900,28900
459: 18900 ivpass = ivpass + 1
460: write (i02,80001) ivtnum
461: go to 8911
462: 28900 ivfail = ivfail + 1
463: rvcorr = -21.000
464: write (i02,80005) ivtnum, rvcomp, rvcorr
465: 8911 continue
466: c
467: c tests 891 and 892 contain intrinsic function tests for choosing
468: c smallest value where arguments are integer and function is real
469: c
470: ivtnum = 891
471: c
472: c **** test 891 ****
473: c
474: if (iczero) 38910, 8910, 38910
475: 8910 continue
476: ivon01 = -75
477: ivon02 = -243
478: rvcomp = amin0 (ivon01,ivon02)
479: go to 48910
480: 38910 ivdele = ivdele + 1
481: write (i02,80003) ivtnum
482: if (iczero) 48910, 8921, 48910
483: 48910 if (rvcomp + 243.05) 28910,18910,48911
484: 48911 if (rvcomp + 242.95) 18910,18910,28910
485: 18910 ivpass = ivpass + 1
486: write (i02,80001) ivtnum
487: go to 8921
488: 28910 ivfail = ivfail + 1
489: rvcorr = -243.00
490: write (i02,80005) ivtnum, rvcomp, rvcorr
491: 8921 continue
492: ivtnum = 892
493: c
494: c **** test 892 ****
495: c
496: if (iczero) 38920, 8920, 38920
497: 8920 continue
498: ivon01 = -11
499: ivon02 = 11
500: rvcomp = amin0 (0,ivon01,ivon02)
501: go to 48920
502: 38920 ivdele = ivdele + 1
503: write (i02,80003) ivtnum
504: if (iczero) 48920, 8931, 48920
505: 48920 if (rvcomp + 11.005) 28920,18920,48921
506: 48921 if (rvcomp + 10.995) 18920,18920,28920
507: 18920 ivpass = ivpass + 1
508: write (i02,80001) ivtnum
509: go to 8931
510: 28920 ivfail = ivfail + 1
511: rvcorr = -11.000
512: write (i02,80005) ivtnum, rvcomp, rvcorr
513: 8931 continue
514: c
515: c tests 893 and 894 contain intrinsic function tests for choosing
516: c smallest value where arguments and function are real
517: c
518: ivtnum = 893
519: c
520: c **** test 893 ****
521: c
522: if (iczero) 38930, 8930, 38930
523: 8930 continue
524: rvon01 = 1.1111
525: rvon02 = 22.222
526: rvon03 = 333.33
527: rvcomp = amin1 (rvon01,rvon02,rvon03)
528: go to 48930
529: 38930 ivdele = ivdele + 1
530: write (i02,80003) ivtnum
531: if (iczero) 48930, 8941, 48930
532: 48930 if (rvcomp - 1.1106) 28930,18930,48931
533: 48931 if (rvcomp - 1.1116) 18930,18930,28930
534: 18930 ivpass = ivpass + 1
535: write (i02,80001) ivtnum
536: go to 8941
537: 28930 ivfail = ivfail + 1
538: rvcorr = 1.1111
539: write (i02,80005) ivtnum, rvcomp, rvcorr
540: 8941 continue
541: ivtnum = 894
542: c
543: c **** test 894 ****
544: c
545: if (iczero) 38940, 8940, 38940
546: 8940 continue
547: rvon01 = 28.8
548: rvon02 = 2.88e1
549: rvon03 = 288e-1
550: rvon04 = 35.0
551: rvcomp = amin1 (rvon01,rvon02,rvon03,rvon04)
552: go to 48940
553: 38940 ivdele = ivdele + 1
554: write (i02,80003) ivtnum
555: if (iczero) 48940, 8951, 48940
556: 48940 if (rvcomp - 28.795) 28940,18940,48941
557: 48941 if (rvcomp - 28.805) 18940,18940,28940
558: 18940 ivpass = ivpass + 1
559: write (i02,80001) ivtnum
560: go to 8951
561: 28940 ivfail = ivfail + 1
562: rvcorr = 28.800
563: write (i02,80005) ivtnum, rvcomp, rvcorr
564: 8951 continue
565: c
566: c test 895 through test 897 contain intrinsic function tests for
567: c float - conversion of an integer argument to real function
568: c
569: ivtnum = 895
570: c
571: c **** test 895 ****
572: c
573: if (iczero) 38950, 8950, 38950
574: 8950 continue
575: rvcomp = float (-606)
576: go to 48950
577: 38950 ivdele = ivdele + 1
578: write (i02,80003) ivtnum
579: if (iczero) 48950, 8961, 48950
580: 48950 if (rvcomp + 606.05) 28950,18950,48951
581: 48951 if (rvcomp + 605.95) 18950,18950,28950
582: 18950 ivpass = ivpass + 1
583: write (i02,80001) ivtnum
584: go to 8961
585: 28950 ivfail = ivfail + 1
586: rvcorr = -606.00
587: write (i02,80005) ivtnum, rvcomp, rvcorr
588: 8961 continue
589: ivtnum = 896
590: c
591: c **** test 896 ****
592: c
593: if (iczero) 38960, 8960, 38960
594: 8960 continue
595: ivon01 = 71
596: rvcomp = float (ivon01)
597: go to 48960
598: 38960 ivdele = ivdele + 1
599: write (i02,80003) ivtnum
600: if (iczero) 48960, 8971, 48960
601: 48960 if (rvcomp - 70.995) 28960,18960,48961
602: 48961 if (rvcomp - 71.005) 18960,18960,28960
603: 18960 ivpass = ivpass + 1
604: write (i02,80001) ivtnum
605: go to 8971
606: 28960 ivfail = ivfail + 1
607: rvcorr = 71.000
608: write (i02,80005) ivtnum, rvcomp, rvcorr
609: 8971 continue
610: ivtnum = 897
611: c
612: c **** test 897 ****
613: c
614: if (iczero) 38970, 8970, 38970
615: 8970 continue
616: ivon01 = 321
617: rvcomp = float (-ivon01)
618: go to 48970
619: 38970 ivdele = ivdele + 1
620: write (i02,80003) ivtnum
621: if (iczero) 48970, 8981, 48970
622: 48970 if (rvcomp + 321.05) 28970,18970,48971
623: 48971 if (rvcomp + 320.95) 18970,18970,28970
624: 18970 ivpass = ivpass + 1
625: write (i02,80001) ivtnum
626: go to 8981
627: 28970 ivfail = ivfail + 1
628: rvcorr = -321.00
629: write (i02,80005) ivtnum, rvcomp, rvcorr
630: 8981 continue
631: c
632: c test 898 through test 900 contain intrinsic function tests for
633: c transfer of sign - both arguments and function are real
634: c
635: ivtnum = 898
636: c
637: c **** test 898 ****
638: c
639: if (iczero) 38980, 8980, 38980
640: 8980 continue
641: rvon01 = 64.3
642: rvcomp = sign (rvon01,-1.0)
643: go to 48980
644: 38980 ivdele = ivdele + 1
645: write (i02,80003) ivtnum
646: if (iczero) 48980, 8991, 48980
647: 48980 if (rvcomp + 64.305) 28980,18980,48981
648: 48981 if (rvcomp + 64.295) 18980,18980,28980
649: 18980 ivpass = ivpass + 1
650: write (i02,80001) ivtnum
651: go to 8991
652: 28980 ivfail = ivfail + 1
653: rvcorr = -64.300
654: write (i02,80005) ivtnum, rvcomp, rvcorr
655: 8991 continue
656: ivtnum = 899
657: c
658: c **** test 899 ****
659: c
660: if (iczero) 38990, 8990, 38990
661: 8990 continue
662: rvon01 = -2.2
663: rvon02 = 7.23e1
664: rvcomp = sign (rvon01,rvon02)
665: go to 48990
666: 38990 ivdele = ivdele + 1
667: write (i02,80003) ivtnum
668: if (iczero) 48990, 9001, 48990
669: 48990 if (rvcomp - 2.1995) 28990,18990,48991
670: 48991 if (rvcomp - 2.2005) 18990,18990,28990
671: 18990 ivpass = ivpass + 1
672: write (i02,80001) ivtnum
673: go to 9001
674: 28990 ivfail = ivfail + 1
675: rvcorr = 2.2000
676: write (i02,80005) ivtnum, rvcomp, rvcorr
677: 9001 continue
678: ivtnum = 900
679: c
680: c **** test 900 ****
681: c
682: if (iczero) 39000, 9000, 39000
683: 9000 continue
684: rvon01 = 35.32e+1
685: rvon02 = 1.0
686: rvcomp = sign (rvon01,rvon02)
687: go to 49000
688: 39000 ivdele = ivdele + 1
689: write (i02,80003) ivtnum
690: if (iczero) 49000, 9011, 49000
691: 49000 if (rvcomp - 353.15) 29000,19000,49001
692: 49001 if (rvcomp - 353.25) 19000,19000,29000
693: 19000 ivpass = ivpass + 1
694: write (i02,80001) ivtnum
695: go to 9011
696: 29000 ivfail = ivfail + 1
697: rvcorr = 353.20
698: write (i02,80005) ivtnum, rvcomp, rvcorr
699: 9011 continue
700: c
701: c test 901 through test 904 contain intrinsic function tests for
702: c positive difference where arguments and function are real
703: c
704: ivtnum = 901
705: c
706: c **** test 901 ****
707: c
708: if (iczero) 39010, 9010, 39010
709: 9010 continue
710: rvon01 = 22.2
711: rvcomp = dim (rvon01,1.0)
712: go to 49010
713: 39010 ivdele = ivdele + 1
714: write (i02,80003) ivtnum
715: if (iczero) 49010, 9021, 49010
716: 49010 if (rvcomp - 21.195) 29010,19010,49011
717: 49011 if (rvcomp - 21.205) 19010,19010,29010
718: 19010 ivpass = ivpass + 1
719: write (i02,80001) ivtnum
720: go to 9021
721: 29010 ivfail = ivfail + 1
722: rvcorr = 21.200
723: write (i02,80005) ivtnum, rvcomp, rvcorr
724: 9021 continue
725: ivtnum = 902
726: c
727: c **** test 902 ****
728: c
729: if (iczero) 39020, 9020, 39020
730: 9020 continue
731: rvon01 = 4.5e1
732: rvon02 = 41.0
733: rvcomp = dim (rvon01,rvon02)
734: go to 49020
735: 39020 ivdele = ivdele + 1
736: write (i02,80003) ivtnum
737: if (iczero) 49020, 9031, 49020
738: 49020 if (rvcomp - 3.9995) 29020,19020,49021
739: 49021 if (rvcomp - 4.0005) 19020,19020,29020
740: 19020 ivpass = ivpass + 1
741: write (i02,80001) ivtnum
742: go to 9031
743: 29020 ivfail = ivfail + 1
744: rvcorr = 4.0000
745: write (i02,80005) ivtnum, rvcomp, rvcorr
746: 9031 continue
747: ivtnum = 903
748: c
749: c **** test 903 ****
750: c
751: if (iczero) 39030, 9030, 39030
752: 9030 continue
753: rvon01 = 2.0
754: rvon02 = 10.0
755: rvcomp = dim (rvon01,rvon02)
756: go to 49030
757: 39030 ivdele = ivdele + 1
758: write (i02,80003) ivtnum
759: if (iczero) 49030, 9041, 49030
760: 49030 if (rvcomp) 29030,19030,29030
761: 19030 ivpass = ivpass + 1
762: write (i02,80001) ivtnum
763: go to 9041
764: 29030 ivfail = ivfail + 1
765: rvcorr = 0.0000
766: write (i02,80005) ivtnum, rvcomp, rvcorr
767: 9041 continue
768: ivtnum = 904
769: c
770: c **** test 904 ****
771: c
772: if (iczero) 39040, 9040, 39040
773: 9040 continue
774: rvon01 = 1.65e+1
775: rvon02 = -2.0
776: rvcomp = dim (rvon01,rvon02)
777: go to 49040
778: 39040 ivdele = ivdele + 1
779: write (i02,80003) ivtnum
780: if (iczero) 49040, 9051, 49040
781: 49040 if (rvcomp - 18.495) 29040,19040,49041
782: 49041 if (rvcomp - 18.505) 19040,19040,29040
783: 19040 ivpass = ivpass + 1
784: write (i02,80001) ivtnum
785: go to 9051
786: 29040 ivfail = ivfail + 1
787: rvcorr = 18.500
788: write (i02,80005) ivtnum, rvcomp, rvcorr
789: 9051 continue
790: c
791: c tests 905 and 906 contain expressions containing more than one
792: c intrinsic function - all arguments and functions are real
793: c
794: ivtnum = 905
795: c
796: c **** test 905 ****
797: c
798: if (iczero) 39050, 9050, 39050
799: 9050 continue
800: rvon01 = 33.3
801: rvon02 = -12.1
802: rvcomp = aint (rvon01) + abs (rvon02)
803: go to 49050
804: 39050 ivdele = ivdele + 1
805: write (i02,80003) ivtnum
806: if (iczero) 49050, 9061, 49050
807: 49050 if (rvcomp - 45.095) 29050,19050,49051
808: 49051 if (rvcomp - 45.105) 19050,19050,29050
809: 19050 ivpass = ivpass + 1
810: write (i02,80001) ivtnum
811: go to 9061
812: 29050 ivfail = ivfail + 1
813: rvcorr = 45.100
814: write (i02,80005) ivtnum, rvcomp, rvcorr
815: 9061 continue
816: ivtnum = 906
817: c
818: c **** test 906 ****
819: c
820: if (iczero) 39060, 9060, 39060
821: 9060 continue
822: rvon01 = 76.3
823: rvon02 = 2.1e1
824: rvon03 = 3e1
825: rvcomp = amax1(rvon01,rvon02,rvon03)-amin1(rvon01,rvon02,rvon03)
826: go to 49060
827: 39060 ivdele = ivdele + 1
828: write (i02,80003) ivtnum
829: if (iczero) 49060, 9071, 49060
830: 49060 if (rvcomp - 55.295) 29060,19060,49061
831: 49061 if (rvcomp - 55.305) 19060,19060,29060
832: 19060 ivpass = ivpass + 1
833: write (i02,80001) ivtnum
834: go to 9071
835: 29060 ivfail = ivfail + 1
836: rvcorr = 55.300
837: write (i02,80005) ivtnum, rvcomp, rvcorr
838: 9071 continue
839: c
840: c write page footings and run summaries
841: 99999 continue
842: write (i02,90002)
843: write (i02,90006)
844: write (i02,90002)
845: write (i02,90002)
846: write (i02,90007)
847: write (i02,90002)
848: write (i02,90008) ivfail
849: write (i02,90009) ivpass
850: write (i02,90010) ivdele
851: c
852: c
853: c terminate routine execution
854: stop
855: c
856: c format statements for page headers
857: 90000 format (1h1)
858: 90002 format (1h )
859: 90001 format (1h ,10x,34hfortran compiler validation system)
860: 90003 format (1h ,21x,11hversion 1.0)
861: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
862: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
863: 90006 format (1h ,5x,46h----------------------------------------------)
864: 90011 format (1h ,18x,17hsubset level test)
865: c
866: c format statements for run summaries
867: 90008 format (1h ,15x,i5,19h errors encountered)
868: 90009 format (1h ,15x,i5,13h tests passed)
869: 90010 format (1h ,15x,i5,14h tests deleted)
870: c
871: c format statements for test results
872: 80001 format (1h ,4x,i5,7x,4hpass)
873: 80002 format (1h ,4x,i5,7x,4hfail)
874: 80003 format (1h ,4x,i5,7x,7hdeleted)
875: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
876: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
877: c
878: 90007 format (1h ,20x,20hend of program fm097)
879: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.