![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm098.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 fm098.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 fm098
4: c
5: c this routine tests intrinsic functions where the function type is
6: c integer and the arguments are either integer or real. the real
7: c and integer variables and the real and integer constants contain
8: c both positive and negative values. the intrinsic functions tested
9: c by fm098 include
10: c type of
11: c intrinsic function name argument function
12: c ------------------ ---- -------- --------
13: c absolute value iabs integer integer
14: c truncation int real integer
15: c remaindering mod integer integer
16: c choosing largest value max0 integer integer
17: c max1 real integer
18: c choosing smallest value min0 integer integer
19: c min1 real integer
20: c fix ifix real integer
21: c transfer of sign isign integer integer
22: c positive difference idim integer integer
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 907 through test 909 contain intrinsic function tests for
106: c absolute value where argument and function are integer
107: c
108: 9071 continue
109: ivtnum = 907
110: c
111: c **** test 907 ****
112: c
113: if (iczero) 39070, 9070, 39070
114: 9070 continue
115: ivcomp = iabs (-382)
116: go to 49070
117: 39070 ivdele = ivdele + 1
118: write (i02,80003) ivtnum
119: if (iczero) 49070, 9081, 49070
120: 49070 if (ivcomp - 382) 29070,19070,29070
121: 19070 ivpass = ivpass + 1
122: write (i02,80001) ivtnum
123: go to 9081
124: 29070 ivfail = ivfail + 1
125: ivcorr = 382
126: write (i02,80004) ivtnum, ivcomp, ivcorr
127: 9081 continue
128: ivtnum = 908
129: c
130: c **** test 908 ****
131: c
132: if (iczero) 39080, 9080, 39080
133: 9080 continue
134: ivon01 = 445
135: ivcomp = iabs (ivon01)
136: go to 49080
137: 39080 ivdele = ivdele + 1
138: write (i02,80003) ivtnum
139: if (iczero) 49080, 9091, 49080
140: 49080 if (ivcomp - 445) 29080,19080,29080
141: 19080 ivpass = ivpass + 1
142: write (i02,80001) ivtnum
143: go to 9091
144: 29080 ivfail = ivfail + 1
145: ivcorr = 445
146: write (i02,80004) ivtnum, ivcomp, ivcorr
147: 9091 continue
148: ivtnum = 909
149: c
150: c **** test 909 ****
151: c
152: if (iczero) 39090, 9090, 39090
153: 9090 continue
154: ivon01 = -32176
155: ivcomp = iabs (ivon01)
156: go to 49090
157: 39090 ivdele = ivdele + 1
158: write (i02,80003) ivtnum
159: if (iczero) 49090, 9101, 49090
160: 49090 if (ivcomp - 32176) 29090,19090,29090
161: 19090 ivpass = ivpass + 1
162: write (i02,80001) ivtnum
163: go to 9101
164: 29090 ivfail = ivfail + 1
165: ivcorr = 32176
166: write (i02,80004) ivtnum, ivcomp, ivcorr
167: c
168: c test 910 through test 913 contain intrinsic function tests for
169: c truncation where argument is real and function is integer
170: c
171: 9101 continue
172: ivtnum = 910
173: c
174: c **** test 910 ****
175: c
176: if (iczero) 39100, 9100, 39100
177: 9100 continue
178: ivcomp = int (38.2)
179: go to 49100
180: 39100 ivdele = ivdele + 1
181: write (i02,80003) ivtnum
182: if (iczero) 49100, 9111, 49100
183: 49100 if (ivcomp - 38) 29100,19100,29100
184: 19100 ivpass = ivpass + 1
185: write (i02,80001) ivtnum
186: go to 9111
187: 29100 ivfail = ivfail + 1
188: ivcorr = 38
189: write (i02,80004) ivtnum, ivcomp, ivcorr
190: 9111 continue
191: ivtnum = 911
192: c
193: c **** test 911 ****
194: c
195: if (iczero) 39110, 9110, 39110
196: 9110 continue
197: rvon01 = -445.95
198: ivcomp = int (rvon01)
199: go to 49110
200: 39110 ivdele = ivdele + 1
201: write (i02,80003) ivtnum
202: if (iczero) 49110, 9121, 49110
203: 49110 if (ivcomp + 445) 29110,19110,29110
204: 19110 ivpass = ivpass + 1
205: write (i02,80001) ivtnum
206: go to 9121
207: 29110 ivfail = ivfail + 1
208: ivcorr = -445
209: write (i02,80004) ivtnum, ivcomp, ivcorr
210: 9121 continue
211: ivtnum = 912
212: c
213: c **** test 912 ****
214: c
215: if (iczero) 39120, 9120, 39120
216: 9120 continue
217: rvon01 = 466.01
218: ivcomp = int (rvon01)
219: go to 49120
220: 39120 ivdele = ivdele + 1
221: write (i02,80003) ivtnum
222: if (iczero) 49120, 9131, 49120
223: 49120 if (ivcomp - 466) 29120,19120,29120
224: 19120 ivpass = ivpass + 1
225: write (i02,80001) ivtnum
226: go to 9131
227: 29120 ivfail = ivfail + 1
228: ivcorr = 466
229: write (i02,80004) ivtnum, ivcomp, ivcorr
230: 9131 continue
231: ivtnum = 913
232: c
233: c **** test 913 ****
234: c
235: if (iczero) 39130, 9130, 39130
236: 9130 continue
237: rvon01 = 382e-1
238: ivcomp = int (rvon01)
239: go to 49130
240: 39130 ivdele = ivdele + 1
241: write (i02,80003) ivtnum
242: if (iczero) 49130, 9141, 49130
243: 49130 if (ivcomp - 38) 29130,19130,29130
244: 19130 ivpass = ivpass + 1
245: write (i02,80001) ivtnum
246: go to 9141
247: 29130 ivfail = ivfail + 1
248: ivcorr = 38
249: write (i02,80004) ivtnum, ivcomp, ivcorr
250: c
251: c test 914 through test 917 contain intrinsic function tests for
252: c remaindering where arguments and function are integers
253: c
254: 9141 continue
255: ivtnum = 914
256: c
257: c **** test 914 ****
258: c
259: if (iczero) 39140, 9140, 39140
260: 9140 continue
261: ivcomp = mod (42,19)
262: go to 49140
263: 39140 ivdele = ivdele + 1
264: write (i02,80003) ivtnum
265: if (iczero) 49140, 9151, 49140
266: 49140 if (ivcomp - 4) 29140,19140,29140
267: 19140 ivpass = ivpass + 1
268: write (i02,80001) ivtnum
269: go to 9151
270: 29140 ivfail = ivfail + 1
271: ivcorr = 4
272: write (i02,80004) ivtnum, ivcomp, ivcorr
273: 9151 continue
274: ivtnum = 915
275: c
276: c **** test 915 ****
277: c
278: if (iczero) 39150, 9150, 39150
279: 9150 continue
280: ivon01 = 6667
281: ivon02 = 2
282: ivcomp = mod (ivon01,ivon02)
283: go to 49150
284: 39150 ivdele = ivdele + 1
285: write (i02,80003) ivtnum
286: if (iczero) 49150, 9161, 49150
287: 49150 if (ivcomp - 1) 29150,19150,29150
288: 19150 ivpass = ivpass + 1
289: write (i02,80001) ivtnum
290: go to 9161
291: 29150 ivfail = ivfail + 1
292: ivcorr = 1
293: write (i02,80004) ivtnum, ivcomp, ivcorr
294: 9161 continue
295: ivtnum = 916
296: c
297: c **** test 916 ****
298: c
299: if (iczero) 39160, 9160, 39160
300: 9160 continue
301: ivon01 = 225
302: ivon02 = 50
303: ivcomp = mod (ivon01,ivon02)
304: go to 49160
305: 39160 ivdele = ivdele + 1
306: write (i02,80003) ivtnum
307: if (iczero) 49160, 9171, 49160
308: 49160 if (ivcomp - 25) 29160,19160,29160
309: 19160 ivpass = ivpass + 1
310: write (i02,80001) ivtnum
311: go to 9171
312: 29160 ivfail = ivfail + 1
313: ivcorr = 25
314: write (i02,80004) ivtnum, ivcomp, ivcorr
315: 9171 continue
316: ivtnum = 917
317: c
318: c **** test 917 ****
319: c
320: if (iczero) 39170, 9170, 39170
321: 9170 continue
322: ivon01 = -39
323: ivon02 = 500
324: ivcomp = mod (ivon01,ivon02)
325: go to 49170
326: 39170 ivdele = ivdele + 1
327: write (i02,80003) ivtnum
328: if (iczero) 49170, 9181, 49170
329: 49170 if (ivcomp + 39) 29170,19170,29170
330: 19170 ivpass = ivpass + 1
331: write (i02,80001) ivtnum
332: go to 9181
333: 29170 ivfail = ivfail + 1
334: ivcorr = -39
335: write (i02,80004) ivtnum, ivcomp, ivcorr
336: c
337: c test 918 and 919 contain intrinsic function tests for choosing
338: c largest value where arguments and function are integer
339: c
340: 9181 continue
341: ivtnum = 918
342: c
343: c **** test 918 ****
344: c
345: if (iczero) 39180, 9180, 39180
346: 9180 continue
347: ivon01 = 317
348: ivon02 = -99
349: ivon03 = 1
350: ivcomp = max0 (263,ivon01,ivon02,ivon03)
351: go to 49180
352: 39180 ivdele = ivdele + 1
353: write (i02,80003) ivtnum
354: if (iczero) 49180, 9191, 49180
355: 49180 if (ivcomp - 317) 29180,19180,29180
356: 19180 ivpass = ivpass + 1
357: write (i02,80001) ivtnum
358: go to 9191
359: 29180 ivfail = ivfail + 1
360: ivcorr = 317
361: write (i02,80004) ivtnum, ivcomp, ivcorr
362: 9191 continue
363: ivtnum = 919
364: c
365: c **** test 919 ****
366: c
367: if (iczero) 39190, 9190, 39190
368: 9190 continue
369: ivon01 = 2572
370: ivon02 = 2570
371: ivcomp = max0 (ivon01,ivon02)
372: go to 49190
373: 39190 ivdele = ivdele + 1
374: write (i02,80003) ivtnum
375: if (iczero) 49190, 9201, 49190
376: 49190 if (ivcomp - 2572) 29190,19190,29190
377: 19190 ivpass = ivpass + 1
378: write (i02,80001) ivtnum
379: go to 9201
380: 29190 ivfail = ivfail + 1
381: ivcorr = 2572
382: write (i02,80004) ivtnum, ivcomp, ivcorr
383: c
384: c test 920 and 921 contain intrinsic function tests for choosing
385: c largest value where arguments are real and function is integer
386: c
387: 9201 continue
388: ivtnum = 920
389: c
390: c **** test 920 ****
391: c
392: if (iczero) 39200, 9200, 39200
393: 9200 continue
394: rvon01 = .326e+2
395: rvon02 = 22.075
396: rvon03 = 76e-1
397: ivcomp = max1 (rvon01,rvon02,rvon03)
398: go to 49200
399: 39200 ivdele = ivdele + 1
400: write (i02,80003) ivtnum
401: if (iczero) 49200, 9211, 49200
402: 49200 if (ivcomp - 32) 29200,19200,29200
403: 19200 ivpass = ivpass + 1
404: write (i02,80001) ivtnum
405: go to 9211
406: 29200 ivfail = ivfail + 1
407: ivcorr = 32
408: write (i02,80004) ivtnum, ivcomp, ivcorr
409: 9211 continue
410: ivtnum = 921
411: c
412: c **** test 921 ****
413: c
414: if (iczero) 39210, 9210, 39210
415: 9210 continue
416: rvon01 = -6.3e2
417: rvon02 = -21.0
418: ivcomp = max1 (-463.3,rvon01,rvon02)
419: go to 49210
420: 39210 ivdele = ivdele + 1
421: write (i02,80003) ivtnum
422: if (iczero) 49210, 9221, 49210
423: 49210 if (ivcomp + 21) 29210,19210,29210
424: 19210 ivpass = ivpass + 1
425: write (i02,80001) ivtnum
426: go to 9221
427: 29210 ivfail = ivfail + 1
428: ivcorr = -21
429: write (i02,80004) ivtnum, ivcomp, ivcorr
430: c
431: c test 922 and 923 contain intrinsic function tests for choosing
432: c smallest value where arguments and function are integer
433: c
434: 9221 continue
435: ivtnum = 922
436: c
437: c **** test 922 ****
438: c
439: if (iczero) 39220, 9220, 39220
440: 9220 continue
441: ivon01 = -75
442: ivon02 = -243
443: ivcomp = min0 (ivon01,ivon02)
444: go to 49220
445: 39220 ivdele = ivdele + 1
446: write (i02,80003) ivtnum
447: if (iczero) 49220, 9231, 49220
448: 49220 if (ivcomp + 243) 29220,19220,29220
449: 19220 ivpass = ivpass + 1
450: write (i02,80001) ivtnum
451: go to 9231
452: 29220 ivfail = ivfail + 1
453: ivcorr = -243
454: write (i02,80004) ivtnum, ivcomp, ivcorr
455: 9231 continue
456: ivtnum = 923
457: c
458: c **** test 923 ****
459: c
460: if (iczero) 39230, 9230, 39230
461: 9230 continue
462: ivon01 = -11
463: ivon02 = 11
464: ivcomp = min0 (0,ivon01,ivon02)
465: go to 49230
466: 39230 ivdele = ivdele + 1
467: write (i02,80003) ivtnum
468: if (iczero) 49230, 9241, 49230
469: 49230 if (ivcomp + 11) 29230,19230,29230
470: 19230 ivpass = ivpass + 1
471: write (i02,80001) ivtnum
472: go to 9241
473: 29230 ivfail = ivfail + 1
474: ivcorr = -11
475: write (i02,80004) ivtnum, ivcomp, ivcorr
476: c
477: c test 924 and 925 contain intrinsic function tests for choosing
478: c smallest value where arguments are real and function is integer
479: c
480: 9241 continue
481: ivtnum = 924
482: c
483: c **** test 924 ****
484: c
485: if (iczero) 39240, 9240, 39240
486: 9240 continue
487: rvon01 = 1.1111
488: rvon02 = 22.222
489: rvon03 = 333.33
490: ivcomp = min1 (rvon01,rvon02,rvon03)
491: go to 49240
492: 39240 ivdele = ivdele + 1
493: write (i02,80003) ivtnum
494: if (iczero) 49240, 9251, 49240
495: 49240 if (ivcomp - 1) 29240,19240,29240
496: 19240 ivpass = ivpass + 1
497: write (i02,80001) ivtnum
498: go to 9251
499: 29240 ivfail = ivfail + 1
500: ivcorr = 1
501: write (i02,80004) ivtnum, ivcomp, ivcorr
502: 9251 continue
503: ivtnum = 925
504: c
505: c **** test 925 ****
506: c
507: if (iczero) 39250, 9250, 39250
508: 9250 continue
509: rvon01 = 28.8
510: rvon02 = 2.88e1
511: rvon03 = 288e-1
512: rvon04 = 35.0
513: ivcomp = min1 (rvon01,rvon02,rvon03,rvon04)
514: go to 49250
515: 39250 ivdele = ivdele + 1
516: write (i02,80003) ivtnum
517: if (iczero) 49250, 9261, 49250
518: 49250 if (ivcomp - 28) 29250,19250,29250
519: 19250 ivpass = ivpass + 1
520: write (i02,80001) ivtnum
521: go to 9261
522: 29250 ivfail = ivfail + 1
523: ivcorr = 28
524: write (i02,80004) ivtnum, ivcomp, ivcorr
525: c
526: c test 926 through test 929 contain the intrinsic function fix
527: c which converts real arguments to integer function results
528: c
529: 9261 continue
530: ivtnum = 926
531: c
532: c **** test 926 ****
533: c
534: if (iczero) 39260, 9260, 39260
535: 9260 continue
536: ivcomp = ifix (-6.06)
537: go to 49260
538: 39260 ivdele = ivdele + 1
539: write (i02,80003) ivtnum
540: if (iczero) 49260, 9271, 49260
541: 49260 if (ivcomp + 6) 29260,19260,29260
542: 19260 ivpass = ivpass + 1
543: write (i02,80001) ivtnum
544: go to 9271
545: 29260 ivfail = ivfail + 1
546: ivcorr = -6
547: write (i02,80004) ivtnum, ivcomp, ivcorr
548: 9271 continue
549: ivtnum = 927
550: c
551: c **** test 927 ****
552: c
553: if (iczero) 39270, 9270, 39270
554: 9270 continue
555: rvon01 = 71.01
556: ivcomp = ifix (rvon01)
557: go to 49270
558: 39270 ivdele = ivdele + 1
559: write (i02,80003) ivtnum
560: if (iczero) 49270, 9281, 49270
561: 49270 if (ivcomp - 71) 29270,19270,29270
562: 19270 ivpass = ivpass + 1
563: write (i02,80001) ivtnum
564: go to 9281
565: 29270 ivfail = ivfail + 1
566: ivcorr = 71
567: write (i02,80004) ivtnum, ivcomp, ivcorr
568: 9281 continue
569: ivtnum = 928
570: c
571: c **** test 928 ****
572: c
573: if (iczero) 39280, 9280, 39280
574: 9280 continue
575: rvon01 = 3.211e2
576: ivcomp = ifix (rvon01)
577: go to 49280
578: 39280 ivdele = ivdele + 1
579: write (i02,80003) ivtnum
580: if (iczero) 49280, 9291, 49280
581: 49280 if (ivcomp - 321) 29280,19280,29280
582: 19280 ivpass = ivpass + 1
583: write (i02,80001) ivtnum
584: go to 9291
585: 29280 ivfail = ivfail + 1
586: ivcorr = 321
587: write (i02,80004) ivtnum, ivcomp, ivcorr
588: 9291 continue
589: ivtnum = 929
590: c
591: c **** test 929 ****
592: c
593: if (iczero) 39290, 9290, 39290
594: 9290 continue
595: rvon01 = 777e-1
596: ivcomp = ifix (rvon01)
597: go to 49290
598: 39290 ivdele = ivdele + 1
599: write (i02,80003) ivtnum
600: if (iczero) 49290, 9301, 49290
601: 49290 if (ivcomp - 77) 29290,19290,29290
602: 19290 ivpass = ivpass + 1
603: write (i02,80001) ivtnum
604: go to 9301
605: 29290 ivfail = ivfail + 1
606: ivcorr = 77
607: write (i02,80004) ivtnum, ivcomp, ivcorr
608: c
609: c test 930 through test 932 contain intrinsic function tests for
610: c transfer of sign where arguments and function are integer
611: c
612: 9301 continue
613: ivtnum = 930
614: c
615: c **** test 930 ****
616: c
617: if (iczero) 39300, 9300, 39300
618: 9300 continue
619: ivon01 = 643
620: ivcomp = isign (ivon01,-1)
621: go to 49300
622: 39300 ivdele = ivdele + 1
623: write (i02,80003) ivtnum
624: if (iczero) 49300, 9311, 49300
625: 49300 if (ivcomp + 643) 29300,19300,29300
626: 19300 ivpass = ivpass + 1
627: write (i02,80001) ivtnum
628: go to 9311
629: 29300 ivfail = ivfail + 1
630: ivcorr = -643
631: write (i02,80004) ivtnum, ivcomp, ivcorr
632: 9311 continue
633: ivtnum = 931
634: c
635: c **** test 931 ****
636: c
637: if (iczero) 39310, 9310, 39310
638: 9310 continue
639: ivon01 = -22
640: ivon02 = 723
641: ivcomp = isign (ivon01,ivon02)
642: go to 49310
643: 39310 ivdele = ivdele + 1
644: write (i02,80003) ivtnum
645: if (iczero) 49310, 9321, 49310
646: 49310 if (ivcomp - 22) 29310,19310,29310
647: 19310 ivpass = ivpass + 1
648: write (i02,80001) ivtnum
649: go to 9321
650: 29310 ivfail = ivfail + 1
651: ivcorr = 22
652: write (i02,80004) ivtnum, ivcomp, ivcorr
653: 9321 continue
654: ivtnum = 932
655: c
656: c **** test 932 ****
657: c
658: if (iczero) 39320, 9320, 39320
659: 9320 continue
660: ivon01 = 3532
661: ivon02 = 1
662: ivcomp = isign (ivon01,ivon02)
663: go to 49320
664: 39320 ivdele = ivdele + 1
665: write (i02,80003) ivtnum
666: if (iczero) 49320, 9331, 49320
667: 49320 if (ivcomp - 3532) 29320,19320,29320
668: 19320 ivpass = ivpass + 1
669: write (i02,80001) ivtnum
670: go to 9331
671: 29320 ivfail = ivfail + 1
672: ivcorr = 3532
673: write (i02,80004) ivtnum, ivcomp, ivcorr
674: c
675: c test 933 through test 936 contain intrinsic function tests for
676: c positive difference where arguments and function are integers
677: c
678: 9331 continue
679: ivtnum = 933
680: c
681: c **** test 933 ****
682: c
683: if (iczero) 39330, 9330, 39330
684: 9330 continue
685: ivon01 = 222
686: ivcomp = idim (ivon01,1)
687: go to 49330
688: 39330 ivdele = ivdele + 1
689: write (i02,80003) ivtnum
690: if (iczero) 49330, 9341, 49330
691: 49330 if (ivcomp - 221) 29330,19330,29330
692: 19330 ivpass = ivpass + 1
693: write (i02,80001) ivtnum
694: go to 9341
695: 29330 ivfail = ivfail + 1
696: ivcorr = 221
697: write (i02,80004) ivtnum, ivcomp, ivcorr
698: 9341 continue
699: ivtnum = 934
700: c
701: c **** test 934 ****
702: c
703: if (iczero) 39340, 9340, 39340
704: 9340 continue
705: ivon01 = 45
706: ivon02 = 41
707: ivcomp = idim (ivon01,ivon02)
708: go to 49340
709: 39340 ivdele = ivdele + 1
710: write (i02,80003) ivtnum
711: if (iczero) 49340, 9351, 49340
712: 49340 if (ivcomp - 4) 29340,19340,29340
713: 19340 ivpass = ivpass + 1
714: write (i02,80001) ivtnum
715: go to 9351
716: 29340 ivfail = ivfail + 1
717: ivcorr = 4
718: write (i02,80004) ivtnum, ivcomp, ivcorr
719: 9351 continue
720: ivtnum = 935
721: c
722: c **** test 935 ****
723: c
724: if (iczero) 39350, 9350, 39350
725: 9350 continue
726: ivon01 = 2
727: ivon02 = 10
728: ivcomp = idim (ivon01,ivon02)
729: go to 49350
730: 39350 ivdele = ivdele + 1
731: write (i02,80003) ivtnum
732: if (iczero) 49350, 9361, 49350
733: 49350 if (ivcomp) 29350,19350,29350
734: 19350 ivpass = ivpass + 1
735: write (i02,80001) ivtnum
736: go to 9361
737: 29350 ivfail = ivfail + 1
738: ivcorr = 0
739: write (i02,80004) ivtnum, ivcomp, ivcorr
740: 9361 continue
741: ivtnum = 936
742: c
743: c **** test 936 ****
744: c
745: if (iczero) 39360, 9360, 39360
746: 9360 continue
747: ivon01 = 165
748: ivon02 = -2
749: ivcomp = idim (ivon01,ivon02)
750: go to 49360
751: 39360 ivdele = ivdele + 1
752: write (i02,80003) ivtnum
753: if (iczero) 49360, 9371, 49360
754: 49360 if (ivcomp - 167) 29360,19360,29360
755: 19360 ivpass = ivpass + 1
756: write (i02,80001) ivtnum
757: go to 9371
758: 29360 ivfail = ivfail + 1
759: ivcorr = 167
760: write (i02,80004) ivtnum, ivcomp, ivcorr
761: c
762: c tests 937 and 938 contain expressions containing more than one
763: c intrinsic function - the functions are integer and the arguments
764: c are real and integer
765: c
766: 9371 continue
767: ivtnum = 937
768: c
769: c **** test 937 ****
770: c
771: if (iczero) 39370, 9370, 39370
772: 9370 continue
773: rvon01 = 33.3
774: ivon01 = -12
775: ivcomp = int (rvon01) + iabs (ivon01)
776: go to 49370
777: 39370 ivdele = ivdele + 1
778: write (i02,80003) ivtnum
779: if (iczero) 49370, 9381, 49370
780: 49370 if (ivcomp - 45) 29370,19370,29370
781: 19370 ivpass = ivpass + 1
782: write (i02,80001) ivtnum
783: go to 9381
784: 29370 ivfail = ivfail + 1
785: ivcorr = 45
786: write (i02,80004) ivtnum, ivcomp, ivcorr
787: 9381 continue
788: ivtnum = 938
789: c
790: c **** test 938 ****
791: c
792: if (iczero) 39380, 9380, 39380
793: 9380 continue
794: ivon01 = 76
795: ivon02 = 21
796: ivon03 = 30
797: ivcomp = max0 (ivon01,ivon02,ivon03) - min0 (ivon01,ivon02,ivon03)
798: go to 49380
799: 39380 ivdele = ivdele + 1
800: write (i02,80003) ivtnum
801: if (iczero) 49380, 9391, 49380
802: 49380 if (ivcomp - 55) 29380,19380,29380
803: 19380 ivpass = ivpass + 1
804: write (i02,80001) ivtnum
805: go to 9391
806: 29380 ivfail = ivfail + 1
807: ivcorr = 55
808: write (i02,80004) ivtnum, ivcomp, ivcorr
809: 9391 continue
810: c
811: c write page footings and run summaries
812: 99999 continue
813: write (i02,90002)
814: write (i02,90006)
815: write (i02,90002)
816: write (i02,90002)
817: write (i02,90007)
818: write (i02,90002)
819: write (i02,90008) ivfail
820: write (i02,90009) ivpass
821: write (i02,90010) ivdele
822: c
823: c
824: c terminate routine execution
825: stop
826: c
827: c format statements for page headers
828: 90000 format (1h1)
829: 90002 format (1h )
830: 90001 format (1h ,10x,34hfortran compiler validation system)
831: 90003 format (1h ,21x,11hversion 1.0)
832: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
833: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
834: 90006 format (1h ,5x,46h----------------------------------------------)
835: 90011 format (1h ,18x,17hsubset level test)
836: c
837: c format statements for run summaries
838: 90008 format (1h ,15x,i5,19h errors encountered)
839: 90009 format (1h ,15x,i5,13h tests passed)
840: 90010 format (1h ,15x,i5,14h tests deleted)
841: c
842: c format statements for test results
843: 80001 format (1h ,4x,i5,7x,4hpass)
844: 80002 format (1h ,4x,i5,7x,4hfail)
845: 80003 format (1h ,4x,i5,7x,7hdeleted)
846: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
847: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
848: c
849: 90007 format (1h ,20x,20hend of program fm098)
850: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.