![[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 [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests|
Return to FM097.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 root 1: C COMMENT SECTION 00010097
2: C DATE***82/08/02*18.33.46
3: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
4: C AUDIT FCVS78 V2.0
5: C 00020097
6: C FM097 00030097
7: C 00040097
8: C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION TYPE IS 00050097
9: C REAL AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE REAL AND 00060097
10: C INTEGER VARIABLES AND THE REAL AND INTEGER CONSTANTS CONTAIN BOTH 00070097
11: C POSITIVE AND NEGATIVE VALUES. THE INTRINSIC FUNCTIONS TESTED BY 00080097
12: C FM097 INCLUDE 00090097
13: C TYPE OF 00100097
14: C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION 00110097
15: C ------------------ ---- -------- -------- 00120097
16: C ABSOLUTE VALUE ABS REAL REAL 00130097
17: C TRUNCATION AINT REAL REAL 00140097
18: C REMAINDERING AMOD REAL REAL 00150097
19: C CHOOSING LARGEST VALUE AMAX0 INTEGER REAL 00160097
20: C AMAX1 REAL REAL 00170097
21: C CHOOSING SMALLEST VALUE AMIN0 INTEGER REAL 00180097
22: C AMIN1 REAL REAL 00190097
23: C FLOAT FLOAT INTEGER REAL 00200097
24: C TRANSFER OF SIGN SIGN REAL REAL 00210097
25: C POSITIVE DIFFERENCE DIM REAL REAL 00220097
26: C 00230097
27: C REFERENCES 00240097
28: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00250097
29: C X3.9-1978 00260097
30: C 00270097
31: C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS 00280097
32: C SECTION 15.3, INTRINSIC FUNCTION 00290097
33: C SECTION 15.3.2, INTRINSIC FUNCTIONS AND THEIR REFERENCE 00300097
34: C 00310097
35: C 00320097
36: C ********************************************************** 00330097
37: C 00340097
38: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00350097
39: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00360097
40: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00370097
41: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00380097
42: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00390097
43: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00400097
44: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00410097
45: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00420097
46: C OF EXECUTING THESE TESTS. 00430097
47: C 00440097
48: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00450097
49: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00460097
50: C 00470097
51: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00480097
52: C 00490097
53: C DEPARTMENT OF THE NAVY 00500097
54: C FEDERAL COBOL COMPILER TESTING SERVICE 00510097
55: C WASHINGTON, D.C. 20376 00520097
56: C 00530097
57: C ********************************************************** 00540097
58: C 00550097
59: C 00560097
60: C 00570097
61: C INITIALIZATION SECTION 00580097
62: C 00590097
63: C INITIALIZE CONSTANTS 00600097
64: C ************** 00610097
65: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620097
66: I01 = 5 00630097
67: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640097
68: I02 = 6 00650097
69: C SYSTEM ENVIRONMENT SECTION 00660097
70: C 00670097
71: I01 = 5 00680097
72: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690097
73: C (UNIT NUMBER FOR CARD READER). 00700097
74: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00710097
75: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00720097
76: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00730097
77: C 00740097
78: I02 = 6 00750097
79: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00760097
80: C (UNIT NUMBER FOR PRINTER). 00770097
81: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00780097
82: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00790097
83: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00800097
84: C 00810097
85: IVPASS=0 00820097
86: IVFAIL=0 00830097
87: IVDELE=0 00840097
88: ICZERO=0 00850097
89: C 00860097
90: C WRITE PAGE HEADERS 00870097
91: WRITE (I02,90000) 00880097
92: WRITE (I02,90001) 00890097
93: WRITE (I02,90002) 00900097
94: WRITE (I02, 90002) 00910097
95: WRITE (I02,90003) 00920097
96: WRITE (I02,90002) 00930097
97: WRITE (I02,90004) 00940097
98: WRITE (I02,90002) 00950097
99: WRITE (I02,90011) 00960097
100: WRITE (I02,90002) 00970097
101: WRITE (I02,90002) 00980097
102: WRITE (I02,90005) 00990097
103: WRITE (I02,90006) 01000097
104: WRITE (I02,90002) 01010097
105: C 01020097
106: C TEST SECTION 01030097
107: C 01040097
108: C TEST 875 THROUGH TEST 878 CONTAIN INTRINSIC FUNCTION TESTS FOR 01050097
109: C ABSOLUTE VALUE WHERE ARGUMENT AND FUNCTION ARE REAL 01060097
110: C 01070097
111: IVTNUM = 875 01080097
112: C 01090097
113: C **** TEST 875 **** 01100097
114: C 01110097
115: IF (ICZERO) 38750, 8750, 38750 01120097
116: 8750 CONTINUE 01130097
117: RVCOMP = ABS (-38.2) 01140097
118: GO TO 48750 01150097
119: 38750 IVDELE = IVDELE + 1 01160097
120: WRITE (I02,80003) IVTNUM 01170097
121: IF (ICZERO) 48750, 8761, 48750 01180097
122: 48750 IF (RVCOMP - 38.195) 28750,18750,48751 01190097
123: 48751 IF (RVCOMP - 38.205) 18750,18750,28750 01200097
124: 18750 IVPASS = IVPASS + 1 01210097
125: WRITE (I02,80001) IVTNUM 01220097
126: GO TO 8761 01230097
127: 28750 IVFAIL = IVFAIL + 1 01240097
128: RVCORR = 38.200 01250097
129: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01260097
130: 8761 CONTINUE 01270097
131: IVTNUM = 876 01280097
132: C 01290097
133: C **** TEST 876 **** 01300097
134: C 01310097
135: IF (ICZERO) 38760, 8760, 38760 01320097
136: 8760 CONTINUE 01330097
137: RVON01 = 445.06 01340097
138: RVCOMP = ABS (RVON01) 01350097
139: GO TO 48760 01360097
140: 38760 IVDELE = IVDELE + 1 01370097
141: WRITE (I02,80003) IVTNUM 01380097
142: IF (ICZERO) 48760, 8771, 48760 01390097
143: 48760 IF (RVCOMP - 445.01) 28760,18760,48761 01400097
144: 48761 IF (RVCOMP - 445.11) 18760,18760,28760 01410097
145: 18760 IVPASS = IVPASS + 1 01420097
146: WRITE (I02,80001) IVTNUM 01430097
147: GO TO 8771 01440097
148: 28760 IVFAIL = IVFAIL + 1 01450097
149: RVCORR = 445.06 01460097
150: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01470097
151: 8771 CONTINUE 01480097
152: IVTNUM = 877 01490097
153: C 01500097
154: C **** TEST 877 **** 01510097
155: C 01520097
156: IF (ICZERO) 38770, 8770, 38770 01530097
157: 8770 CONTINUE 01540097
158: RVON01 = -32.176 01550097
159: RVCOMP = ABS (RVON01) 01560097
160: GO TO 48770 01570097
161: 38770 IVDELE = IVDELE + 1 01580097
162: WRITE (I02,80003) IVTNUM 01590097
163: IF (ICZERO) 48770, 8781, 48770 01600097
164: 48770 IF (RVCOMP - 32.171) 28770,18770,48771 01610097
165: 48771 IF (RVCOMP - 32.181) 18770,18770,28770 01620097
166: 18770 IVPASS = IVPASS + 1 01630097
167: WRITE (I02,80001) IVTNUM 01640097
168: GO TO 8781 01650097
169: 28770 IVFAIL = IVFAIL + 1 01660097
170: RVCORR = 32.176 01670097
171: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01680097
172: 8781 CONTINUE 01690097
173: IVTNUM = 878 01700097
174: C 01710097
175: C **** TEST 878 **** 01720097
176: C 01730097
177: IF (ICZERO) 38780, 8780, 38780 01740097
178: 8780 CONTINUE 01750097
179: RVON01 = -2.2E+2 01760097
180: RVCOMP = ABS (RVON01) 01770097
181: GO TO 48780 01780097
182: 38780 IVDELE = IVDELE + 1 01790097
183: WRITE (I02,80003) IVTNUM 01800097
184: IF (ICZERO) 48780, 8791, 48780 01810097
185: 48780 IF (RVCOMP - 219.95) 28780,18780,48781 01820097
186: 48781 IF (RVCOMP - 220.05) 18780,18780,28780 01830097
187: 18780 IVPASS = IVPASS + 1 01840097
188: WRITE (I02,80001) IVTNUM 01850097
189: GO TO 8791 01860097
190: 28780 IVFAIL = IVFAIL + 1 01870097
191: RVCORR = 220.00 01880097
192: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01890097
193: 8791 CONTINUE 01900097
194: IVTNUM = 879 01910097
195: C 01920097
196: C **** TEST 879 **** 01930097
197: C 01940097
198: C TEST 879 THROUGH TEST 882 CONTAIN INTRINSIC FUNCTION TESTS FOR 01950097
199: C TRUNCATION WHERE ARGUMENT AND FUNCTION ARE REAL 01960097
200: C 01970097
201: C 01980097
202: IF (ICZERO) 38790, 8790, 38790 01990097
203: 8790 CONTINUE 02000097
204: RVCOMP = AINT (38.2) 02010097
205: GO TO 48790 02020097
206: 38790 IVDELE = IVDELE + 1 02030097
207: WRITE (I02,80003) IVTNUM 02040097
208: IF (ICZERO) 48790, 8801, 48790 02050097
209: 48790 IF (RVCOMP - 37.995) 28790,18790,48791 02060097
210: 48791 IF (RVCOMP - 38.005) 18790,18790,28790 02070097
211: 18790 IVPASS = IVPASS + 1 02080097
212: WRITE (I02,80001) IVTNUM 02090097
213: GO TO 8801 02100097
214: 28790 IVFAIL = IVFAIL + 1 02110097
215: RVCORR = 38.000 02120097
216: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02130097
217: 8801 CONTINUE 02140097
218: IVTNUM = 880 02150097
219: C 02160097
220: C **** TEST 880 **** 02170097
221: C 02180097
222: IF (ICZERO) 38800, 8800, 38800 02190097
223: 8800 CONTINUE 02200097
224: RVON01 = -445.95 02210097
225: RVCOMP = AINT (RVON01) 02220097
226: GO TO 48800 02230097
227: 38800 IVDELE = IVDELE + 1 02240097
228: WRITE (I02,80003) IVTNUM 02250097
229: IF (ICZERO) 48800, 8811, 48800 02260097
230: 48800 IF (RVCOMP + 445.05) 28800,18800,48801 02270097
231: 48801 IF (RVCOMP + 444.95) 18800,18800,28800 02280097
232: 18800 IVPASS = IVPASS + 1 02290097
233: WRITE (I02,80001) IVTNUM 02300097
234: GO TO 8811 02310097
235: 28800 IVFAIL = IVFAIL + 1 02320097
236: RVCORR = -445.00 02330097
237: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02340097
238: 8811 CONTINUE 02350097
239: IVTNUM = 881 02360097
240: C 02370097
241: C **** TEST 881 **** 02380097
242: C 02390097
243: IF (ICZERO) 38810, 8810, 38810 02400097
244: 8810 CONTINUE 02410097
245: RVON01 = 466.01 02420097
246: RVCOMP = AINT (RVON01) 02430097
247: GO TO 48810 02440097
248: 38810 IVDELE = IVDELE + 1 02450097
249: WRITE (I02,80003) IVTNUM 02460097
250: IF (ICZERO) 48810, 8821, 48810 02470097
251: 48810 IF (RVCOMP - 465.95) 28810,18810,48811 02480097
252: 48811 IF (RVCOMP - 466.05) 18810,18810,28810 02490097
253: 18810 IVPASS = IVPASS + 1 02500097
254: WRITE (I02,80001) IVTNUM 02510097
255: GO TO 8821 02520097
256: 28810 IVFAIL = IVFAIL + 1 02530097
257: RVCOMP = 466.00 02540097
258: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02550097
259: 8821 CONTINUE 02560097
260: IVTNUM = 882 02570097
261: C 02580097
262: C **** TEST 882 **** 02590097
263: C 02600097
264: IF (ICZERO) 38820, 8820, 38820 02610097
265: 8820 CONTINUE 02620097
266: RVON01 = 382E-1 02630097
267: RVCOMP = AINT (RVON01) 02640097
268: GO TO 48820 02650097
269: 38820 IVDELE = IVDELE + 1 02660097
270: WRITE (I02,80003) IVTNUM 02670097
271: IF (ICZERO) 48820, 8831, 48820 02680097
272: 48820 IF (RVCOMP - 37.995) 28820,18820,48821 02690097
273: 48821 IF (RVCOMP - 38.005) 18820,18820,28820 02700097
274: 18820 IVPASS = IVPASS + 1 02710097
275: WRITE (I02,80001) IVTNUM 02720097
276: GO TO 8831 02730097
277: 28820 IVFAIL = IVFAIL + 1 02740097
278: RVCORR = 38.000 02750097
279: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02760097
280: 8831 CONTINUE 02770097
281: C 02780097
282: C TEST 883 THROUGH 886 CONTAIN INTRINSIC FUNCTION TESTS FOR 02790097
283: C REMAINDERING WHERE ARGUMENT AND FUNCTION ARE REAL 02800097
284: C 02810097
285: IVTNUM = 883 02820097
286: C 02830097
287: C **** TEST 883 **** 02840097
288: C 02850097
289: IF (ICZERO) 38830, 8830, 38830 02860097
290: 8830 CONTINUE 02870097
291: RVCOMP = AMOD (42.0,19.0) 02880097
292: GO TO 48830 02890097
293: 38830 IVDELE = IVDELE + 1 02900097
294: WRITE (I02,80003) IVTNUM 02910097
295: IF (ICZERO) 48830, 8841, 48830 02920097
296: 48830 IF (RVCOMP - 3.9995) 28830,18830,48831 02930097
297: 48831 IF (RVCOMP - 4.0005) 18830,18830,28830 02940097
298: 18830 IVPASS = IVPASS + 1 02950097
299: WRITE (I02,80001) IVTNUM 02960097
300: GO TO 8841 02970097
301: 28830 IVFAIL = IVFAIL + 1 02980097
302: RVCORR = 4.0000 02990097
303: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03000097
304: 8841 CONTINUE 03010097
305: IVTNUM = 884 03020097
306: C 03030097
307: C **** TEST 884 **** 03040097
308: C 03050097
309: IF (ICZERO) 38840, 8840, 38840 03060097
310: 8840 CONTINUE 03070097
311: RVON01 = 16.27 03080097
312: RVON02 = 2.0 03090097
313: RVCOMP = AMOD (RVON01,RVON02) 03100097
314: GO TO 48840 03110097
315: 38840 IVDELE = IVDELE + 1 03120097
316: WRITE (I02,80003) IVTNUM 03130097
317: IF (ICZERO) 48840, 8851, 48840 03140097
318: 48840 IF (RVCOMP - .26995) 28840,18840,48841 03150097
319: 48841 IF (RVCOMP - .27005) 18840,18840,28840 03160097
320: 18840 IVPASS = IVPASS + 1 03170097
321: WRITE (I02,80001) IVTNUM 03180097
322: GO TO 8851 03190097
323: 28840 IVFAIL = IVFAIL + 1 03200097
324: RVCORR = .27000 03210097
325: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03220097
326: 8851 CONTINUE 03230097
327: IVTNUM = 885 03240097
328: C 03250097
329: C **** TEST 885 **** 03260097
330: C 03270097
331: IF (ICZERO) 38850, 8850, 38850 03280097
332: 8850 CONTINUE 03290097
333: RVON01 = 225.0 03300097
334: RVON02 = 5.0E1 03310097
335: RVCOMP = AMOD (RVON01,RVON02) 03320097
336: GO TO 48850 03330097
337: 38850 IVDELE = IVDELE + 1 03340097
338: WRITE (I02,80003) IVTNUM 03350097
339: IF (ICZERO) 48850, 8861, 48850 03360097
340: 48850 IF (RVCOMP - 24.995) 28850,18850,48851 03370097
341: 48851 IF (RVCOMP - 25.005) 18850,18850,28850 03380097
342: 18850 IVPASS = IVPASS + 1 03390097
343: WRITE (I02,80001) IVTNUM 03400097
344: GO TO 8861 03410097
345: 28850 IVFAIL = IVFAIL + 1 03420097
346: RVCORR = 25.000 03430097
347: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03440097
348: 8861 CONTINUE 03450097
349: IVTNUM = 886 03460097
350: C 03470097
351: C **** TEST 886 **** 03480097
352: C 03490097
353: IF (ICZERO) 38860, 8860, 38860 03500097
354: 8860 CONTINUE 03510097
355: RVON01 = -0.390E+2 03520097
356: RVON02 = 5E2 03530097
357: RVCOMP = AMOD (RVON01,RVON02) 03540097
358: GO TO 48860 03550097
359: 38860 IVDELE = IVDELE + 1 03560097
360: WRITE (I02,80003) IVTNUM 03570097
361: IF (ICZERO) 48860, 8871, 48860 03580097
362: 48860 IF (RVCOMP + 39.005) 28860,18860,48861 03590097
363: 48861 IF (RVCOMP + 38.995) 18860,18860,28860 03600097
364: 18860 IVPASS = IVPASS + 1 03610097
365: WRITE (I02,80001) IVTNUM 03620097
366: GO TO 8871 03630097
367: 28860 IVFAIL = IVFAIL + 1 03640097
368: RVCORR = -39.000 03650097
369: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03660097
370: 8871 CONTINUE 03670097
371: C 03680097
372: C TEST 887 AND 888 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 03690097
373: C LARGEST VALUE WHERE ARGUMENTS ARE INTEGER AND FUNCTION IS REAL 03700097
374: C 03710097
375: IVTNUM = 887 03720097
376: C 03730097
377: C **** TEST 887 **** 03740097
378: C 03750097
379: IF (ICZERO) 38870, 8870, 38870 03760097
380: 8870 CONTINUE 03770097
381: IVON01 = 317 03780097
382: IVON02 = -99 03790097
383: IVON03 = 1 03800097
384: RVCOMP = AMAX0 (263,IVON01,IVON02,IVON03) 03810097
385: GO TO 48870 03820097
386: 38870 IVDELE = IVDELE + 1 03830097
387: WRITE (I02,80003) IVTNUM 03840097
388: IF (ICZERO) 48870, 8881, 48870 03850097
389: 48870 IF (RVCOMP - 316.95) 28870,18870,48871 03860097
390: 48871 IF (RVCOMP - 317.05) 18870,18870,28870 03870097
391: 18870 IVPASS = IVPASS + 1 03880097
392: WRITE (I02,80001) IVTNUM 03890097
393: GO TO 8881 03900097
394: 28870 IVFAIL = IVFAIL + 1 03910097
395: RVCORR = 317.00 03920097
396: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03930097
397: 8881 CONTINUE 03940097
398: IVTNUM = 888 03950097
399: C 03960097
400: C **** TEST 888 **** 03970097
401: C 03980097
402: IF (ICZERO) 38880, 8880, 38880 03990097
403: 8880 CONTINUE 04000097
404: IVON01 = 2572 04010097
405: IVON02 = 2570 04020097
406: RVCOMP = AMAX0 (IVON01,IVON02) 04030097
407: GO TO 48880 04040097
408: 38880 IVDELE = IVDELE + 1 04050097
409: WRITE (I02,80003) IVTNUM 04060097
410: IF (ICZERO) 48880, 8891, 48880 04070097
411: 48880 IF (RVCOMP - 2571.5) 28880,18880,48881 04080097
412: 48881 IF (RVCOMP - 2572.5) 18880,18880,28880 04090097
413: 18880 IVPASS = IVPASS + 1 04100097
414: WRITE (I02,80001) IVTNUM 04110097
415: GO TO 8891 04120097
416: 28880 IVFAIL = IVFAIL + 1 04130097
417: RVCORR = 2572.0 04140097
418: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04150097
419: 8891 CONTINUE 04160097
420: C 04170097
421: C TEST 889 AND 890 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04180097
422: C LARGEST VALUE WHERE THE ARGUMENTS AND FUNCTION ARE REAL 04190097
423: C 04200097
424: IVTNUM = 889 04210097
425: C 04220097
426: C **** TEST 889 **** 04230097
427: C 04240097
428: IF (ICZERO) 38890, 8890, 38890 04250097
429: 8890 CONTINUE 04260097
430: RVON01 = .326E+2 04270097
431: RVON02 = 22.075 04280097
432: RVON03 = 76E-1 04290097
433: RVCOMP = AMAX1 (RVON01,RVON02,RVON03) 04300097
434: GO TO 48890 04310097
435: 38890 IVDELE = IVDELE + 1 04320097
436: WRITE (I02,80003) IVTNUM 04330097
437: IF (ICZERO) 48890, 8901, 48890 04340097
438: 48890 IF (RVCOMP - 32.595) 28890,18890,48891 04350097
439: 48891 IF (RVCOMP - 32.605) 18890,18890,28890 04360097
440: 18890 IVPASS = IVPASS + 1 04370097
441: WRITE (I02,80001) IVTNUM 04380097
442: GO TO 8901 04390097
443: 28890 IVFAIL = IVFAIL + 1 04400097
444: RVCORR = 32.600 04410097
445: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04420097
446: 8901 CONTINUE 04430097
447: IVTNUM = 890 04440097
448: C 04450097
449: C **** TEST 890 **** 04460097
450: C 04470097
451: IF (ICZERO) 38900, 8900, 38900 04480097
452: 8900 CONTINUE 04490097
453: RVON01 = -6.3E2 04500097
454: RVON02 = -21.0 04510097
455: RVCOMP = AMAX1 (-463.3,RVON01,RVON02) 04520097
456: GO TO 48900 04530097
457: 38900 IVDELE = IVDELE + 1 04540097
458: WRITE (I02,80003) IVTNUM 04550097
459: IF (ICZERO) 48900, 8911, 48900 04560097
460: 48900 IF (RVCOMP + 21.005) 28900,18900,48901 04570097
461: 48901 IF (RVCOMP + 20.995) 18900,18900,28900 04580097
462: 18900 IVPASS = IVPASS + 1 04590097
463: WRITE (I02,80001) IVTNUM 04600097
464: GO TO 8911 04610097
465: 28900 IVFAIL = IVFAIL + 1 04620097
466: RVCORR = -21.000 04630097
467: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04640097
468: 8911 CONTINUE 04650097
469: C 04660097
470: C TESTS 891 AND 892 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04670097
471: C SMALLEST VALUE WHERE ARGUMENTS ARE INTEGER AND FUNCTION IS REAL 04680097
472: C 04690097
473: IVTNUM = 891 04700097
474: C 04710097
475: C **** TEST 891 **** 04720097
476: C 04730097
477: IF (ICZERO) 38910, 8910, 38910 04740097
478: 8910 CONTINUE 04750097
479: IVON01 = -75 04760097
480: IVON02 = -243 04770097
481: RVCOMP = AMIN0 (IVON01,IVON02) 04780097
482: GO TO 48910 04790097
483: 38910 IVDELE = IVDELE + 1 04800097
484: WRITE (I02,80003) IVTNUM 04810097
485: IF (ICZERO) 48910, 8921, 48910 04820097
486: 48910 IF (RVCOMP + 243.05) 28910,18910,48911 04830097
487: 48911 IF (RVCOMP + 242.95) 18910,18910,28910 04840097
488: 18910 IVPASS = IVPASS + 1 04850097
489: WRITE (I02,80001) IVTNUM 04860097
490: GO TO 8921 04870097
491: 28910 IVFAIL = IVFAIL + 1 04880097
492: RVCORR = -243.00 04890097
493: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04900097
494: 8921 CONTINUE 04910097
495: IVTNUM = 892 04920097
496: C 04930097
497: C **** TEST 892 **** 04940097
498: C 04950097
499: IF (ICZERO) 38920, 8920, 38920 04960097
500: 8920 CONTINUE 04970097
501: IVON01 = -11 04980097
502: IVON02 = 11 04990097
503: RVCOMP = AMIN0 (0,IVON01,IVON02) 05000097
504: GO TO 48920 05010097
505: 38920 IVDELE = IVDELE + 1 05020097
506: WRITE (I02,80003) IVTNUM 05030097
507: IF (ICZERO) 48920, 8931, 48920 05040097
508: 48920 IF (RVCOMP + 11.005) 28920,18920,48921 05050097
509: 48921 IF (RVCOMP + 10.995) 18920,18920,28920 05060097
510: 18920 IVPASS = IVPASS + 1 05070097
511: WRITE (I02,80001) IVTNUM 05080097
512: GO TO 8931 05090097
513: 28920 IVFAIL = IVFAIL + 1 05100097
514: RVCORR = -11.000 05110097
515: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05120097
516: 8931 CONTINUE 05130097
517: C 05140097
518: C TESTS 893 AND 894 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 05150097
519: C SMALLEST VALUE WHERE ARGUMENTS AND FUNCTION ARE REAL 05160097
520: C 05170097
521: IVTNUM = 893 05180097
522: C 05190097
523: C **** TEST 893 **** 05200097
524: C 05210097
525: IF (ICZERO) 38930, 8930, 38930 05220097
526: 8930 CONTINUE 05230097
527: RVON01 = 1.1111 05240097
528: RVON02 = 22.222 05250097
529: RVON03 = 333.33 05260097
530: RVCOMP = AMIN1 (RVON01,RVON02,RVON03) 05270097
531: GO TO 48930 05280097
532: 38930 IVDELE = IVDELE + 1 05290097
533: WRITE (I02,80003) IVTNUM 05300097
534: IF (ICZERO) 48930, 8941, 48930 05310097
535: 48930 IF (RVCOMP - 1.1106) 28930,18930,48931 05320097
536: 48931 IF (RVCOMP - 1.1116) 18930,18930,28930 05330097
537: 18930 IVPASS = IVPASS + 1 05340097
538: WRITE (I02,80001) IVTNUM 05350097
539: GO TO 8941 05360097
540: 28930 IVFAIL = IVFAIL + 1 05370097
541: RVCORR = 1.1111 05380097
542: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05390097
543: 8941 CONTINUE 05400097
544: IVTNUM = 894 05410097
545: C 05420097
546: C **** TEST 894 **** 05430097
547: C 05440097
548: IF (ICZERO) 38940, 8940, 38940 05450097
549: 8940 CONTINUE 05460097
550: RVON01 = 28.8 05470097
551: RVON02 = 2.88E1 05480097
552: RVON03 = 288E-1 05490097
553: RVON04 = 35.0 05500097
554: RVCOMP = AMIN1 (RVON01,RVON02,RVON03,RVON04) 05510097
555: GO TO 48940 05520097
556: 38940 IVDELE = IVDELE + 1 05530097
557: WRITE (I02,80003) IVTNUM 05540097
558: IF (ICZERO) 48940, 8951, 48940 05550097
559: 48940 IF (RVCOMP - 28.795) 28940,18940,48941 05560097
560: 48941 IF (RVCOMP - 28.805) 18940,18940,28940 05570097
561: 18940 IVPASS = IVPASS + 1 05580097
562: WRITE (I02,80001) IVTNUM 05590097
563: GO TO 8951 05600097
564: 28940 IVFAIL = IVFAIL + 1 05610097
565: RVCORR = 28.800 05620097
566: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05630097
567: 8951 CONTINUE 05640097
568: C 05650097
569: C TEST 895 THROUGH TEST 897 CONTAIN INTRINSIC FUNCTION TESTS FOR 05660097
570: C FLOAT - CONVERSION OF AN INTEGER ARGUMENT TO REAL FUNCTION 05670097
571: C 05680097
572: IVTNUM = 895 05690097
573: C 05700097
574: C **** TEST 895 **** 05710097
575: C 05720097
576: IF (ICZERO) 38950, 8950, 38950 05730097
577: 8950 CONTINUE 05740097
578: RVCOMP = FLOAT (-606) 05750097
579: GO TO 48950 05760097
580: 38950 IVDELE = IVDELE + 1 05770097
581: WRITE (I02,80003) IVTNUM 05780097
582: IF (ICZERO) 48950, 8961, 48950 05790097
583: 48950 IF (RVCOMP + 606.05) 28950,18950,48951 05800097
584: 48951 IF (RVCOMP + 605.95) 18950,18950,28950 05810097
585: 18950 IVPASS = IVPASS + 1 05820097
586: WRITE (I02,80001) IVTNUM 05830097
587: GO TO 8961 05840097
588: 28950 IVFAIL = IVFAIL + 1 05850097
589: RVCORR = -606.00 05860097
590: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05870097
591: 8961 CONTINUE 05880097
592: IVTNUM = 896 05890097
593: C 05900097
594: C **** TEST 896 **** 05910097
595: C 05920097
596: IF (ICZERO) 38960, 8960, 38960 05930097
597: 8960 CONTINUE 05940097
598: IVON01 = 71 05950097
599: RVCOMP = FLOAT (IVON01) 05960097
600: GO TO 48960 05970097
601: 38960 IVDELE = IVDELE + 1 05980097
602: WRITE (I02,80003) IVTNUM 05990097
603: IF (ICZERO) 48960, 8971, 48960 06000097
604: 48960 IF (RVCOMP - 70.995) 28960,18960,48961 06010097
605: 48961 IF (RVCOMP - 71.005) 18960,18960,28960 06020097
606: 18960 IVPASS = IVPASS + 1 06030097
607: WRITE (I02,80001) IVTNUM 06040097
608: GO TO 8971 06050097
609: 28960 IVFAIL = IVFAIL + 1 06060097
610: RVCORR = 71.000 06070097
611: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06080097
612: 8971 CONTINUE 06090097
613: IVTNUM = 897 06100097
614: C 06110097
615: C **** TEST 897 **** 06120097
616: C 06130097
617: IF (ICZERO) 38970, 8970, 38970 06140097
618: 8970 CONTINUE 06150097
619: IVON01 = 321 06160097
620: RVCOMP = FLOAT (-IVON01) 06170097
621: GO TO 48970 06180097
622: 38970 IVDELE = IVDELE + 1 06190097
623: WRITE (I02,80003) IVTNUM 06200097
624: IF (ICZERO) 48970, 8981, 48970 06210097
625: 48970 IF (RVCOMP + 321.05) 28970,18970,48971 06220097
626: 48971 IF (RVCOMP + 320.95) 18970,18970,28970 06230097
627: 18970 IVPASS = IVPASS + 1 06240097
628: WRITE (I02,80001) IVTNUM 06250097
629: GO TO 8981 06260097
630: 28970 IVFAIL = IVFAIL + 1 06270097
631: RVCORR = -321.00 06280097
632: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06290097
633: 8981 CONTINUE 06300097
634: C 06310097
635: C TEST 898 THROUGH TEST 900 CONTAIN INTRINSIC FUNCTION TESTS FOR 06320097
636: C TRANSFER OF SIGN - BOTH ARGUMENTS AND FUNCTION ARE REAL 06330097
637: C 06340097
638: IVTNUM = 898 06350097
639: C 06360097
640: C **** TEST 898 **** 06370097
641: C 06380097
642: IF (ICZERO) 38980, 8980, 38980 06390097
643: 8980 CONTINUE 06400097
644: RVON01 = 64.3 06410097
645: RVCOMP = SIGN (RVON01,-1.0) 06420097
646: GO TO 48980 06430097
647: 38980 IVDELE = IVDELE + 1 06440097
648: WRITE (I02,80003) IVTNUM 06450097
649: IF (ICZERO) 48980, 8991, 48980 06460097
650: 48980 IF (RVCOMP + 64.305) 28980,18980,48981 06470097
651: 48981 IF (RVCOMP + 64.295) 18980,18980,28980 06480097
652: 18980 IVPASS = IVPASS + 1 06490097
653: WRITE (I02,80001) IVTNUM 06500097
654: GO TO 8991 06510097
655: 28980 IVFAIL = IVFAIL + 1 06520097
656: RVCORR = -64.300 06530097
657: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06540097
658: 8991 CONTINUE 06550097
659: IVTNUM = 899 06560097
660: C 06570097
661: C **** TEST 899 **** 06580097
662: C 06590097
663: IF (ICZERO) 38990, 8990, 38990 06600097
664: 8990 CONTINUE 06610097
665: RVON01 = -2.2 06620097
666: RVON02 = 7.23E1 06630097
667: RVCOMP = SIGN (RVON01,RVON02) 06640097
668: GO TO 48990 06650097
669: 38990 IVDELE = IVDELE + 1 06660097
670: WRITE (I02,80003) IVTNUM 06670097
671: IF (ICZERO) 48990, 9001, 48990 06680097
672: 48990 IF (RVCOMP - 2.1995) 28990,18990,48991 06690097
673: 48991 IF (RVCOMP - 2.2005) 18990,18990,28990 06700097
674: 18990 IVPASS = IVPASS + 1 06710097
675: WRITE (I02,80001) IVTNUM 06720097
676: GO TO 9001 06730097
677: 28990 IVFAIL = IVFAIL + 1 06740097
678: RVCORR = 2.2000 06750097
679: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06760097
680: 9001 CONTINUE 06770097
681: IVTNUM = 900 06780097
682: C 06790097
683: C **** TEST 900 **** 06800097
684: C 06810097
685: IF (ICZERO) 39000, 9000, 39000 06820097
686: 9000 CONTINUE 06830097
687: RVON01 = 35.32E+1 06840097
688: RVON02 = 1.0 06850097
689: RVCOMP = SIGN (RVON01,RVON02) 06860097
690: GO TO 49000 06870097
691: 39000 IVDELE = IVDELE + 1 06880097
692: WRITE (I02,80003) IVTNUM 06890097
693: IF (ICZERO) 49000, 9011, 49000 06900097
694: 49000 IF (RVCOMP - 353.15) 29000,19000,49001 06910097
695: 49001 IF (RVCOMP - 353.25) 19000,19000,29000 06920097
696: 19000 IVPASS = IVPASS + 1 06930097
697: WRITE (I02,80001) IVTNUM 06940097
698: GO TO 9011 06950097
699: 29000 IVFAIL = IVFAIL + 1 06960097
700: RVCORR = 353.20 06970097
701: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06980097
702: 9011 CONTINUE 06990097
703: C 07000097
704: C TEST 901 THROUGH TEST 904 CONTAIN INTRINSIC FUNCTION TESTS FOR 07010097
705: C POSITIVE DIFFERENCE WHERE ARGUMENTS AND FUNCTION ARE REAL 07020097
706: C 07030097
707: IVTNUM = 901 07040097
708: C 07050097
709: C **** TEST 901 **** 07060097
710: C 07070097
711: IF (ICZERO) 39010, 9010, 39010 07080097
712: 9010 CONTINUE 07090097
713: RVON01 = 22.2 07100097
714: RVCOMP = DIM (RVON01,1.0) 07110097
715: GO TO 49010 07120097
716: 39010 IVDELE = IVDELE + 1 07130097
717: WRITE (I02,80003) IVTNUM 07140097
718: IF (ICZERO) 49010, 9021, 49010 07150097
719: 49010 IF (RVCOMP - 21.195) 29010,19010,49011 07160097
720: 49011 IF (RVCOMP - 21.205) 19010,19010,29010 07170097
721: 19010 IVPASS = IVPASS + 1 07180097
722: WRITE (I02,80001) IVTNUM 07190097
723: GO TO 9021 07200097
724: 29010 IVFAIL = IVFAIL + 1 07210097
725: RVCORR = 21.200 07220097
726: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07230097
727: 9021 CONTINUE 07240097
728: IVTNUM = 902 07250097
729: C 07260097
730: C **** TEST 902 **** 07270097
731: C 07280097
732: IF (ICZERO) 39020, 9020, 39020 07290097
733: 9020 CONTINUE 07300097
734: RVON01 = 4.5E1 07310097
735: RVON02 = 41.0 07320097
736: RVCOMP = DIM (RVON01,RVON02) 07330097
737: GO TO 49020 07340097
738: 39020 IVDELE = IVDELE + 1 07350097
739: WRITE (I02,80003) IVTNUM 07360097
740: IF (ICZERO) 49020, 9031, 49020 07370097
741: 49020 IF (RVCOMP - 3.9995) 29020,19020,49021 07380097
742: 49021 IF (RVCOMP - 4.0005) 19020,19020,29020 07390097
743: 19020 IVPASS = IVPASS + 1 07400097
744: WRITE (I02,80001) IVTNUM 07410097
745: GO TO 9031 07420097
746: 29020 IVFAIL = IVFAIL + 1 07430097
747: RVCORR = 4.0000 07440097
748: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07450097
749: 9031 CONTINUE 07460097
750: IVTNUM = 903 07470097
751: C 07480097
752: C **** TEST 903 **** 07490097
753: C 07500097
754: IF (ICZERO) 39030, 9030, 39030 07510097
755: 9030 CONTINUE 07520097
756: RVON01 = 2.0 07530097
757: RVON02 = 10.0 07540097
758: RVCOMP = DIM (RVON01,RVON02) 07550097
759: GO TO 49030 07560097
760: 39030 IVDELE = IVDELE + 1 07570097
761: WRITE (I02,80003) IVTNUM 07580097
762: IF (ICZERO) 49030, 9041, 49030 07590097
763: 49030 IF (RVCOMP) 29030,19030,29030 07600097
764: 19030 IVPASS = IVPASS + 1 07610097
765: WRITE (I02,80001) IVTNUM 07620097
766: GO TO 9041 07630097
767: 29030 IVFAIL = IVFAIL + 1 07640097
768: RVCORR = 0.0000 07650097
769: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07660097
770: 9041 CONTINUE 07670097
771: IVTNUM = 904 07680097
772: C 07690097
773: C **** TEST 904 **** 07700097
774: C 07710097
775: IF (ICZERO) 39040, 9040, 39040 07720097
776: 9040 CONTINUE 07730097
777: RVON01 = 1.65E+1 07740097
778: RVON02 = -2.0 07750097
779: RVCOMP = DIM (RVON01,RVON02) 07760097
780: GO TO 49040 07770097
781: 39040 IVDELE = IVDELE + 1 07780097
782: WRITE (I02,80003) IVTNUM 07790097
783: IF (ICZERO) 49040, 9051, 49040 07800097
784: 49040 IF (RVCOMP - 18.495) 29040,19040,49041 07810097
785: 49041 IF (RVCOMP - 18.505) 19040,19040,29040 07820097
786: 19040 IVPASS = IVPASS + 1 07830097
787: WRITE (I02,80001) IVTNUM 07840097
788: GO TO 9051 07850097
789: 29040 IVFAIL = IVFAIL + 1 07860097
790: RVCORR = 18.500 07870097
791: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07880097
792: 9051 CONTINUE 07890097
793: C 07900097
794: C TESTS 905 AND 906 CONTAIN EXPRESSIONS CONTAINING MORE THAN ONE 07910097
795: C INTRINSIC FUNCTION - ALL ARGUMENTS AND FUNCTIONS ARE REAL 07920097
796: C 07930097
797: IVTNUM = 905 07940097
798: C 07950097
799: C **** TEST 905 **** 07960097
800: C 07970097
801: IF (ICZERO) 39050, 9050, 39050 07980097
802: 9050 CONTINUE 07990097
803: RVON01 = 33.3 08000097
804: RVON02 = -12.1 08010097
805: RVCOMP = AINT (RVON01) + ABS (RVON02) 08020097
806: GO TO 49050 08030097
807: 39050 IVDELE = IVDELE + 1 08040097
808: WRITE (I02,80003) IVTNUM 08050097
809: IF (ICZERO) 49050, 9061, 49050 08060097
810: 49050 IF (RVCOMP - 45.095) 29050,19050,49051 08070097
811: 49051 IF (RVCOMP - 45.105) 19050,19050,29050 08080097
812: 19050 IVPASS = IVPASS + 1 08090097
813: WRITE (I02,80001) IVTNUM 08100097
814: GO TO 9061 08110097
815: 29050 IVFAIL = IVFAIL + 1 08120097
816: RVCORR = 45.100 08130097
817: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08140097
818: 9061 CONTINUE 08150097
819: IVTNUM = 906 08160097
820: C 08170097
821: C **** TEST 906 **** 08180097
822: C 08190097
823: IF (ICZERO) 39060, 9060, 39060 08200097
824: 9060 CONTINUE 08210097
825: RVON01 = 76.3 08220097
826: RVON02 = 2.1E1 08230097
827: RVON03 = 3E1 08240097
828: RVCOMP = AMAX1(RVON01,RVON02,RVON03)-AMIN1(RVON01,RVON02,RVON03) 08250097
829: GO TO 49060 08260097
830: 39060 IVDELE = IVDELE + 1 08270097
831: WRITE (I02,80003) IVTNUM 08280097
832: IF (ICZERO) 49060, 9071, 49060 08290097
833: 49060 IF (RVCOMP - 55.295) 29060,19060,49061 08300097
834: 49061 IF (RVCOMP - 55.305) 19060,19060,29060 08310097
835: 19060 IVPASS = IVPASS + 1 08320097
836: WRITE (I02,80001) IVTNUM 08330097
837: GO TO 9071 08340097
838: 29060 IVFAIL = IVFAIL + 1 08350097
839: RVCORR = 55.300 08360097
840: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08370097
841: 9071 CONTINUE 08380097
842: C 08390097
843: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08400097
844: 99999 CONTINUE 08410097
845: WRITE (I02,90002) 08420097
846: WRITE (I02,90006) 08430097
847: WRITE (I02,90002) 08440097
848: WRITE (I02,90002) 08450097
849: WRITE (I02,90007) 08460097
850: WRITE (I02,90002) 08470097
851: WRITE (I02,90008) IVFAIL 08480097
852: WRITE (I02,90009) IVPASS 08490097
853: WRITE (I02,90010) IVDELE 08500097
854: C 08510097
855: C 08520097
856: C TERMINATE ROUTINE EXECUTION 08530097
857: STOP 08540097
858: C 08550097
859: C FORMAT STATEMENTS FOR PAGE HEADERS 08560097
860: 90000 FORMAT (1H1) 08570097
861: 90002 FORMAT (1H ) 08580097
862: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 08590097
863: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 08600097
864: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 08610097
865: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 08620097
866: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 08630097
867: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 08640097
868: C 08650097
869: C FORMAT STATEMENTS FOR RUN SUMMARIES 08660097
870: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 08670097
871: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 08680097
872: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 08690097
873: C 08700097
874: C FORMAT STATEMENTS FOR TEST RESULTS 08710097
875: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 08720097
876: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 08730097
877: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 08740097
878: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 08750097
879: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 08760097
880: C 08770097
881: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM097) 08780097
882: END 08790097
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.