![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM099.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 FM099.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 00010099
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 00020099
6: C FM099 00030099
7: C 00040099
8: C THIS ROUTINE TESTS VARIOUS MATHEMATICAL FUNCTIONS WHERE BOTH THE 00050099
9: C FUNCTION TYPE AND ARGUMENTS ARE REAL. THE REAL VARIABLES AND 00060099
10: C CONSTANTS CONTAIN BOTH POSITIVE AND NEGATIVE VALUES. THE 00070099
11: C FUNCTIONS TESTED IN FM099 INCLUDE 00080099
12: C 00090099
13: C TYPE OF 00100099
14: C FUNCTION NAME ARGUMENT FUNCTION 00110099
15: C ---------------- ---- -------- -------- 00120099
16: C EXPONENTIAL EXP REAL REAL 00130099
17: C NATURAL LOGARITHM ALOG REAL REAL 00140099
18: C COMMON LOGARITHM ALOG10 REAL REAL 00150099
19: C SQUARE ROOT SQRT REAL REAL 00160099
20: C TRIGONOMETRIC SINE SIN REAL REAL 00170099
21: C TRIGONOMETRIC COSINE COS REAL REAL 00180099
22: C HYPERBOLIC TANGENT TANH REAL REAL 00190099
23: C ARCTANGENT ATAN REAL REAL 00200099
24: C ATAN2 REAL REAL 00210099
25: C 00220099
26: C REFERENCES 00230099
27: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00240099
28: C X3.9-1978 00250099
29: C 00260099
30: C SECTION 8.7, EXTERNAL STATEMENT 00270099
31: C SECTION 15.5.2, FUNCTION REFERENCE 00280099
32: C 00290099
33: C 00300099
34: C ********************************************************** 00310099
35: C 00320099
36: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00330099
37: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00340099
38: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00350099
39: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00360099
40: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00370099
41: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00380099
42: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00390099
43: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00400099
44: C OF EXECUTING THESE TESTS. 00410099
45: C 00420099
46: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00430099
47: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00440099
48: C 00450099
49: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00460099
50: C 00470099
51: C DEPARTMENT OF THE NAVY 00480099
52: C FEDERAL COBOL COMPILER TESTING SERVICE 00490099
53: C WASHINGTON, D.C. 20376 00500099
54: C 00510099
55: C ********************************************************** 00520099
56: C 00530099
57: C 00540099
58: C 00550099
59: C INITIALIZATION SECTION 00560099
60: C 00570099
61: C INITIALIZE CONSTANTS 00580099
62: C ************** 00590099
63: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00600099
64: I01 = 5 00610099
65: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00620099
66: I02 = 6 00630099
67: C SYSTEM ENVIRONMENT SECTION 00640099
68: C 00650099
69: I01 = 5 00660099
70: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670099
71: C (UNIT NUMBER FOR CARD READER). 00680099
72: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00690099
73: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00700099
74: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00710099
75: C 00720099
76: I02 = 6 00730099
77: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00740099
78: C (UNIT NUMBER FOR PRINTER). 00750099
79: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00760099
80: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00770099
81: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00780099
82: C 00790099
83: IVPASS=0 00800099
84: IVFAIL=0 00810099
85: IVDELE=0 00820099
86: ICZERO=0 00830099
87: C 00840099
88: C WRITE PAGE HEADERS 00850099
89: WRITE (I02,90000) 00860099
90: WRITE (I02,90001) 00870099
91: WRITE (I02,90002) 00880099
92: WRITE (I02, 90002) 00890099
93: WRITE (I02,90003) 00900099
94: WRITE (I02,90002) 00910099
95: WRITE (I02,90004) 00920099
96: WRITE (I02,90002) 00930099
97: WRITE (I02,90011) 00940099
98: WRITE (I02,90002) 00950099
99: WRITE (I02,90002) 00960099
100: WRITE (I02,90005) 00970099
101: WRITE (I02,90006) 00980099
102: WRITE (I02,90002) 00990099
103: C 01000099
104: C TEST SECTION 01010099
105: C 01020099
106: C TEST 939 THROUGH TEST 942 CONTAIN FUNCTION TESTS FOR EXPONENTIAL 01030099
107: C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 01040099
108: C 01050099
109: IVTNUM = 939 01060099
110: C 01070099
111: C **** TEST 939 **** 01080099
112: C 01090099
113: IF (ICZERO) 39390, 9390, 39390 01100099
114: 9390 CONTINUE 01110099
115: RVON01 = 0.0 01120099
116: RVCOMP = EXP (RVON01) 01130099
117: GO TO 49390 01140099
118: 39390 IVDELE = IVDELE + 1 01150099
119: WRITE (I02,80003) IVTNUM 01160099
120: IF (ICZERO) 49390, 9401, 49390 01170099
121: 49390 IF (RVCOMP - 0.95) 29390,19390,49391 01180099
122: 49391 IF (RVCOMP - 1.05) 19390,19390,29390 01190099
123: 19390 IVPASS = IVPASS + 1 01200099
124: WRITE (I02,80001) IVTNUM 01210099
125: GO TO 9401 01220099
126: 29390 IVFAIL = IVFAIL + 1 01230099
127: RVCORR = 1.00 01240099
128: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01250099
129: 9401 CONTINUE 01260099
130: IVTNUM = 940 01270099
131: C 01280099
132: C **** TEST 940 **** 01290099
133: C 01300099
134: IF (ICZERO) 39400, 9400, 39400 01310099
135: 9400 CONTINUE 01320099
136: RVCOMP = EXP (0.5) 01330099
137: GO TO 49400 01340099
138: 39400 IVDELE = IVDELE + 1 01350099
139: WRITE (I02,80003) IVTNUM 01360099
140: IF (ICZERO) 49400, 9411, 49400 01370099
141: 49400 IF (RVCOMP - 1.60) 29400,19400,49401 01380099
142: 49401 IF (RVCOMP - 1.70) 19400,19400,29400 01390099
143: 19400 IVPASS = IVPASS + 1 01400099
144: WRITE (I02,80001) IVTNUM 01410099
145: GO TO 9411 01420099
146: 29400 IVFAIL = IVFAIL + 1 01430099
147: RVCORR = 1.65 01440099
148: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01450099
149: 9411 CONTINUE 01460099
150: IVTNUM = 941 01470099
151: C 01480099
152: C **** TEST 941 **** 01490099
153: C 01500099
154: IF (ICZERO) 39410, 9410, 39410 01510099
155: 9410 CONTINUE 01520099
156: RVON01 = .1E1 01530099
157: RVCOMP = EXP (RVON01) 01540099
158: GO TO 49410 01550099
159: 39410 IVDELE = IVDELE + 1 01560099
160: WRITE (I02,80003) IVTNUM 01570099
161: IF (ICZERO) 49410, 9421, 49410 01580099
162: 49410 IF (RVCOMP - 2.67) 29410,19410,49411 01590099
163: 49411 IF (RVCOMP - 2.77) 19410,19410,29410 01600099
164: 19410 IVPASS = IVPASS + 1 01610099
165: WRITE (I02,80001) IVTNUM 01620099
166: GO TO 9421 01630099
167: 29410 IVFAIL = IVFAIL + 1 01640099
168: RVCORR = 2.72 01650099
169: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01660099
170: 9421 CONTINUE 01670099
171: IVTNUM = 942 01680099
172: C 01690099
173: C **** TEST 942 **** 01700099
174: C 01710099
175: IF (ICZERO) 39420, 9420, 39420 01720099
176: 9420 CONTINUE 01730099
177: RVON01 = -1.0 01740099
178: RVCOMP = EXP (RVON01) 01750099
179: GO TO 49420 01760099
180: 39420 IVDELE = IVDELE + 1 01770099
181: WRITE (I02,80003) IVTNUM 01780099
182: IF (ICZERO) 49420, 9431, 49420 01790099
183: 49420 IF (RVCOMP - 0.363) 29420,19420,49421 01800099
184: 49421 IF (RVCOMP - 0.373) 19420,19420,29420 01810099
185: 19420 IVPASS = IVPASS + 1 01820099
186: WRITE (I02,80001) IVTNUM 01830099
187: GO TO 9431 01840099
188: 29420 IVFAIL = IVFAIL + 1 01850099
189: RVCORR = 0.368 01860099
190: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01870099
191: 9431 CONTINUE 01880099
192: C 01890099
193: C TEST 943 THROUGH TEST 945 CONTAIN FUNCTION TESTS FOR NATURAL 01900099
194: C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 01910099
195: C 01920099
196: IVTNUM = 943 01930099
197: C 01940099
198: C **** TEST 943 **** 01950099
199: C 01960099
200: IF (ICZERO) 39430, 9430, 39430 01970099
201: 9430 CONTINUE 01980099
202: RVON01 = 5E1 01990099
203: RVCOMP = ALOG (RVON01) 02000099
204: GO TO 49430 02010099
205: 39430 IVDELE = IVDELE + 1 02020099
206: WRITE (I02,80003) IVTNUM 02030099
207: IF (ICZERO) 49430, 9441, 49430 02040099
208: 49430 IF (RVCOMP - 3.9115) 29430,19430,49431 02050099
209: 49431 IF (RVCOMP - 3.9125) 19430,19430,29430 02060099
210: 19430 IVPASS = IVPASS + 1 02070099
211: WRITE (I02,80001) IVTNUM 02080099
212: GO TO 9441 02090099
213: 29430 IVFAIL = IVFAIL + 1 02100099
214: RVCORR = 3.9120 02110099
215: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02120099
216: 9441 CONTINUE 02130099
217: IVTNUM = 944 02140099
218: C 02150099
219: C **** TEST 944 **** 02160099
220: C 02170099
221: IF (ICZERO) 39440, 9440, 39440 02180099
222: 9440 CONTINUE 02190099
223: RVON01 = 1.0 02200099
224: RVCOMP = ALOG (RVON01) 02210099
225: GO TO 49440 02220099
226: 39440 IVDELE = IVDELE + 1 02230099
227: WRITE (I02,80003) IVTNUM 02240099
228: IF (ICZERO) 49440, 9451, 49440 02250099
229: 49440 IF (RVCOMP + .00005) 29440,19440,49441 02260099
230: 49441 IF (RVCOMP - .00005) 19440,19440,29440 02270099
231: 19440 IVPASS = IVPASS + 1 02280099
232: WRITE (I02,80001) IVTNUM 02290099
233: GO TO 9451 02300099
234: 29440 IVFAIL = IVFAIL + 1 02310099
235: RVCORR = 0.00000 02320099
236: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02330099
237: 9451 CONTINUE 02340099
238: IVTNUM = 945 02350099
239: C 02360099
240: C **** TEST 945 **** 02370099
241: C 02380099
242: IF (ICZERO) 39450, 9450, 39450 02390099
243: 9450 CONTINUE 02400099
244: RVCOMP = ALOG (2.0) 02410099
245: GO TO 49450 02420099
246: 39450 IVDELE = IVDELE + 1 02430099
247: WRITE (I02,80003) IVTNUM 02440099
248: IF (ICZERO) 49450, 9461, 49450 02450099
249: 49450 IF (RVCOMP - 0.688) 29450,19450,49451 02460099
250: 49451 IF (RVCOMP - 0.698) 19450,19450,29450 02470099
251: 19450 IVPASS = IVPASS + 1 02480099
252: WRITE (I02,80001) IVTNUM 02490099
253: GO TO 9461 02500099
254: 29450 IVFAIL = IVFAIL + 1 02510099
255: RVCORR = 0.693 02520099
256: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02530099
257: 9461 CONTINUE 02540099
258: C 02550099
259: C TEST 946 THROUGH TEST 948 CONTAIN FUNCTION TESTS FOR COMMON 02560099
260: C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 02570099
261: C 02580099
262: IVTNUM = 946 02590099
263: C 02600099
264: C **** TEST 946 **** 02610099
265: C 02620099
266: IF (ICZERO) 39460, 9460, 39460 02630099
267: 9460 CONTINUE 02640099
268: RVON01 = 2E2 02650099
269: RVCOMP = ALOG10 (RVON01) 02660099
270: GO TO 49460 02670099
271: 39460 IVDELE = IVDELE + 1 02680099
272: WRITE (I02,80003) IVTNUM 02690099
273: IF (ICZERO) 49460, 9471, 49460 02700099
274: 49460 IF (RVCOMP - 2.296) 29460,19460,49461 02710099
275: 49461 IF (RVCOMP - 2.306) 19460,19460,29460 02720099
276: 19460 IVPASS = IVPASS + 1 02730099
277: WRITE (I02,80001) IVTNUM 02740099
278: GO TO 9471 02750099
279: 29460 IVFAIL = IVFAIL + 1 02760099
280: RVCORR = 2.301 02770099
281: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02780099
282: 9471 CONTINUE 02790099
283: IVTNUM = 947 02800099
284: C 02810099
285: C **** TEST 947 **** 02820099
286: C 02830099
287: IF (ICZERO) 39470, 9470, 39470 02840099
288: 9470 CONTINUE 02850099
289: RVON01 = .3E+3 02860099
290: RVCOMP = ALOG10 (RVON01) 02870099
291: GO TO 49470 02880099
292: 39470 IVDELE = IVDELE + 1 02890099
293: WRITE (I02,80003) IVTNUM 02900099
294: IF (ICZERO) 49470, 9481, 49470 02910099
295: 49470 IF (RVCOMP - 2.472) 29470,19470,49471 02920099
296: 49471 IF (RVCOMP - 2.482) 19470,19470,29470 02930099
297: 19470 IVPASS = IVPASS + 1 02940099
298: WRITE (I02,80001) IVTNUM 02950099
299: GO TO 9481 02960099
300: 29470 IVFAIL = IVFAIL + 1 02970099
301: RVCORR = 2.477 02980099
302: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02990099
303: 9481 CONTINUE 03000099
304: IVTNUM = 948 03010099
305: C 03020099
306: C **** TEST 948 **** 03030099
307: C 03040099
308: IF (ICZERO) 39480, 9480, 39480 03050099
309: 9480 CONTINUE 03060099
310: RVON01 = 1350.0 03070099
311: RVCOMP = ALOG10 (RVON01) 03080099
312: GO TO 49480 03090099
313: 39480 IVDELE = IVDELE + 1 03100099
314: WRITE (I02,80003) IVTNUM 03110099
315: IF (ICZERO) 49480, 9491, 49480 03120099
316: 49480 IF (RVCOMP - 3.125) 29480,19480,49481 03130099
317: 49481 IF (RVCOMP - 3.135) 19480,19480,29480 03140099
318: 19480 IVPASS = IVPASS + 1 03150099
319: WRITE (I02,80001) IVTNUM 03160099
320: GO TO 9491 03170099
321: 29480 IVFAIL = IVFAIL + 1 03180099
322: RVCORR = 3.130 03190099
323: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03200099
324: 9491 CONTINUE 03210099
325: C 03220099
326: C TEST 949 THROUGH TEST 951 CONTAIN FUNCTION TESTS FOR SQUARE ROOT 03230099
327: C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 03240099
328: C 03250099
329: IVTNUM = 949 03260099
330: C 03270099
331: C **** TEST 949 **** 03280099
332: C 03290099
333: IF (ICZERO) 39490, 9490, 39490 03300099
334: 9490 CONTINUE 03310099
335: RVON01 = 1.0 03320099
336: RVCOMP = SQRT (RVON01) 03330099
337: GO TO 49490 03340099
338: 39490 IVDELE = IVDELE + 1 03350099
339: WRITE (I02,80003) IVTNUM 03360099
340: IF (ICZERO) 49490, 9501, 49490 03370099
341: 49490 IF (RVCOMP - 0.95) 29490,19490,49491 03380099
342: 49491 IF (RVCOMP - 1.05) 19490,19490,29490 03390099
343: 19490 IVPASS = IVPASS + 1 03400099
344: WRITE (I02,80001) IVTNUM 03410099
345: GO TO 9501 03420099
346: 29490 IVFAIL = IVFAIL + 1 03430099
347: RVCORR = 1.00 03440099
348: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03450099
349: 9501 CONTINUE 03460099
350: IVTNUM = 950 03470099
351: C 03480099
352: C **** TEST 950 **** 03490099
353: C 03500099
354: IF (ICZERO) 39500, 9500, 39500 03510099
355: 9500 CONTINUE 03520099
356: RVCOMP = SQRT (2.0) 03530099
357: GO TO 49500 03540099
358: 39500 IVDELE = IVDELE + 1 03550099
359: WRITE (I02,80003) IVTNUM 03560099
360: IF (ICZERO) 49500, 9511, 49500 03570099
361: 49500 IF (RVCOMP - 1.36) 29500,19500,49501 03580099
362: 49501 IF (RVCOMP - 1.46) 19500,19500,29500 03590099
363: 19500 IVPASS = IVPASS + 1 03600099
364: WRITE (I02,80001) IVTNUM 03610099
365: GO TO 9511 03620099
366: 29500 IVFAIL = IVFAIL + 1 03630099
367: RVCORR = 1.41 03640099
368: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03650099
369: 9511 CONTINUE 03660099
370: IVTNUM = 951 03670099
371: C 03680099
372: C **** TEST 951 **** 03690099
373: C 03700099
374: IF (ICZERO) 39510, 9510, 39510 03710099
375: 9510 CONTINUE 03720099
376: RVON01 = .229E1 03730099
377: RVCOMP = SQRT (RVON01) 03740099
378: GO TO 49510 03750099
379: 39510 IVDELE = IVDELE + 1 03760099
380: WRITE (I02,80003) IVTNUM 03770099
381: IF (ICZERO) 49510, 9521, 49510 03780099
382: 49510 IF (RVCOMP - 1.46) 29510,19510,49511 03790099
383: 49511 IF (RVCOMP - 1.56) 19510,19510,29510 03800099
384: 19510 IVPASS = IVPASS + 1 03810099
385: WRITE (I02,80001) IVTNUM 03820099
386: GO TO 9521 03830099
387: 29510 IVFAIL = IVFAIL + 1 03840099
388: RVCORR = 1.51 03850099
389: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03860099
390: 9521 CONTINUE 03870099
391: C 03880099
392: C TEST 952 THROUGH TEST 953 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC03890099
393: C SINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 03900099
394: C 03910099
395: IVTNUM = 952 03920099
396: C 03930099
397: C **** TEST 952 **** 03940099
398: C 03950099
399: IF (ICZERO) 39520, 9520, 39520 03960099
400: 9520 CONTINUE 03970099
401: RVON01 = 0.00000 03980099
402: RVCOMP = SIN (RVON01) 03990099
403: GO TO 49520 04000099
404: 39520 IVDELE = IVDELE + 1 04010099
405: WRITE (I02,80003) IVTNUM 04020099
406: IF (ICZERO) 49520, 9531, 49520 04030099
407: 49520 IF (RVCOMP + .00005) 29520,19520,49521 04040099
408: 49521 IF (RVCOMP - .00005) 19520,19520,29520 04050099
409: 19520 IVPASS = IVPASS + 1 04060099
410: WRITE (I02,80001) IVTNUM 04070099
411: GO TO 9531 04080099
412: 29520 IVFAIL = IVFAIL + 1 04090099
413: RVCORR = 0.00000 04100099
414: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04110099
415: 9531 CONTINUE 04120099
416: IVTNUM = 953 04130099
417: C 04140099
418: C **** TEST 953 **** 04150099
419: C 04160099
420: IF (ICZERO) 39530, 9530, 39530 04170099
421: 9530 CONTINUE 04180099
422: RVON01 = 0.5 04190099
423: RVCOMP = SIN (RVON01) 04200099
424: GO TO 49530 04210099
425: 39530 IVDELE = IVDELE + 1 04220099
426: WRITE (I02,80003) IVTNUM 04230099
427: IF (ICZERO) 49530, 9541, 49530 04240099
428: 49530 IF (RVCOMP - .474) 29530,19530,49531 04250099
429: 49531 IF (RVCOMP - .484) 19530,19530,29530 04260099
430: 19530 IVPASS = IVPASS + 1 04270099
431: WRITE (I02,80001) IVTNUM 04280099
432: GO TO 9541 04290099
433: 29530 IVFAIL = IVFAIL + 1 04300099
434: RVCORR = .479 04310099
435: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04320099
436: 9541 CONTINUE 04330099
437: IVTNUM = 954 04340099
438: C 04350099
439: C **** TEST 954 **** 04360099
440: C 04370099
441: IF (ICZERO) 39540, 9540, 39540 04380099
442: 9540 CONTINUE 04390099
443: RVON01 = 4E0 04400099
444: RVCOMP = SIN (RVON01) 04410099
445: GO TO 49540 04420099
446: 39540 IVDELE = IVDELE + 1 04430099
447: WRITE (I02,80003) IVTNUM 04440099
448: IF (ICZERO) 49540, 9551, 49540 04450099
449: 49540 IF (RVCOMP + .762) 29540,19540,49541 04460099
450: 49541 IF (RVCOMP + .752) 19540,19540,29540 04470099
451: 19540 IVPASS = IVPASS + 1 04480099
452: WRITE (I02,80001) IVTNUM 04490099
453: GO TO 9551 04500099
454: 29540 IVFAIL = IVFAIL + 1 04510099
455: RVCORR = -.757 04520099
456: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04530099
457: 9551 CONTINUE 04540099
458: C 04550099
459: C TEST 955 THROUGH TEST 957 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC04560099
460: C COSINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 04570099
461: C 04580099
462: IVTNUM = 955 04590099
463: C 04600099
464: C **** TEST 955 **** 04610099
465: C 04620099
466: IF (ICZERO) 39550, 9550, 39550 04630099
467: 9550 CONTINUE 04640099
468: RVON01 = 0.00000 04650099
469: RVCOMP = COS (RVON01) 04660099
470: GO TO 49550 04670099
471: 39550 IVDELE = IVDELE + 1 04680099
472: WRITE (I02,80003) IVTNUM 04690099
473: IF (ICZERO) 49550, 9561, 49550 04700099
474: 49550 IF (RVCOMP - .995) 29550,19550,49551 04710099
475: 49551 IF (RVCOMP - 1.005) 19550,19550,29550 04720099
476: 19550 IVPASS = IVPASS + 1 04730099
477: WRITE (I02,80001) IVTNUM 04740099
478: GO TO 9561 04750099
479: 29550 IVFAIL = IVFAIL + 1 04760099
480: RVCORR = 1.000 04770099
481: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04780099
482: 9561 CONTINUE 04790099
483: IVTNUM = 956 04800099
484: C 04810099
485: C **** TEST 956 **** 04820099
486: C 04830099
487: IF (ICZERO) 39560, 9560, 39560 04840099
488: 9560 CONTINUE 04850099
489: RVON01 = 1.0E0 04860099
490: RVCOMP = COS (RVON01) 04870099
491: GO TO 49560 04880099
492: 39560 IVDELE = IVDELE + 1 04890099
493: WRITE (I02,80003) IVTNUM 04900099
494: IF (ICZERO) 49560, 9571, 49560 04910099
495: 49560 IF (RVCOMP - .535) 29560,19560,49561 04920099
496: 49561 IF (RVCOMP - .545) 19560,19560,29560 04930099
497: 19560 IVPASS = IVPASS + 1 04940099
498: WRITE (I02,80001) IVTNUM 04950099
499: GO TO 9571 04960099
500: 29560 IVFAIL = IVFAIL + 1 04970099
501: RVCORR = 0.540 04980099
502: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04990099
503: 9571 CONTINUE 05000099
504: IVTNUM = 957 05010099
505: C 05020099
506: C **** TEST 957 **** 05030099
507: C 05040099
508: IF (ICZERO) 39570, 9570, 39570 05050099
509: 9570 CONTINUE 05060099
510: RVCOMP = COS (4.0) 05070099
511: GO TO 49570 05080099
512: 39570 IVDELE = IVDELE + 1 05090099
513: WRITE (I02,80003) IVTNUM 05100099
514: IF (ICZERO) 49570, 9581, 49570 05110099
515: 49570 IF (RVCOMP + .659) 29570,19570,49571 05120099
516: 49571 IF (RVCOMP + .649) 19570,19570,29570 05130099
517: 19570 IVPASS = IVPASS + 1 05140099
518: WRITE (I02,80001) IVTNUM 05150099
519: GO TO 9581 05160099
520: 29570 IVFAIL = IVFAIL + 1 05170099
521: RVCORR = -0.654 05180099
522: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05190099
523: 9581 CONTINUE 05200099
524: C 05210099
525: C TEST 958 THROUGH TEST 960 CONTAIN FUNCTION TESTS FOR HYPERBOLIC 05220099
526: C TANGENT FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 05230099
527: C 05240099
528: IVTNUM = 958 05250099
529: C 05260099
530: C **** TEST 958 **** 05270099
531: C 05280099
532: IF (ICZERO) 39580, 9580, 39580 05290099
533: 9580 CONTINUE 05300099
534: RVCOMP = TANH (0.0) 05310099
535: GO TO 49580 05320099
536: 39580 IVDELE = IVDELE + 1 05330099
537: WRITE (I02,80003) IVTNUM 05340099
538: IF (ICZERO) 49580, 9591, 49580 05350099
539: 49580 IF (RVCOMP + .00005) 29580,19580,49581 05360099
540: 49581 IF (RVCOMP - .00005) 19580,19580,29580 05370099
541: 19580 IVPASS = IVPASS + 1 05380099
542: WRITE (I02,80001) IVTNUM 05390099
543: GO TO 9591 05400099
544: 29580 IVFAIL = IVFAIL + 1 05410099
545: RVCORR = 0.00000 05420099
546: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05430099
547: 9591 CONTINUE 05440099
548: IVTNUM = 959 05450099
549: C 05460099
550: C **** TEST 959 **** 05470099
551: C 05480099
552: IF (ICZERO) 39590, 9590, 39590 05490099
553: 9590 CONTINUE 05500099
554: RVON01 = .5E0 05510099
555: RVCOMP = TANH (RVON01) 05520099
556: GO TO 49590 05530099
557: 39590 IVDELE = IVDELE + 1 05540099
558: WRITE (I02,80003) IVTNUM 05550099
559: IF (ICZERO) 49590, 9601, 49590 05560099
560: 49590 IF (RVCOMP - .457) 29590,19590,49591 05570099
561: 49591 IF (RVCOMP - .467) 19590,19590,29590 05580099
562: 19590 IVPASS = IVPASS + 1 05590099
563: WRITE (I02,80001) IVTNUM 05600099
564: GO TO 9601 05610099
565: 29590 IVFAIL = IVFAIL + 1 05620099
566: RVCORR = 0.462 05630099
567: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05640099
568: 9601 CONTINUE 05650099
569: IVTNUM = 960 05660099
570: C 05670099
571: C **** TEST 960 **** 05680099
572: C 05690099
573: IF (ICZERO) 39600, 9600, 39600 05700099
574: 9600 CONTINUE 05710099
575: RVON01 = .25 05720099
576: RVCOMP = TANH (RVON01) 05730099
577: GO TO 49600 05740099
578: 39600 IVDELE = IVDELE + 1 05750099
579: WRITE (I02,80003) IVTNUM 05760099
580: IF (ICZERO) 49600, 9611, 49600 05770099
581: 49600 IF (RVCOMP - .240) 29600,19600,49601 05780099
582: 49601 IF (RVCOMP - .250) 19600,19600,29600 05790099
583: 19600 IVPASS = IVPASS + 1 05800099
584: WRITE (I02,80001) IVTNUM 05810099
585: GO TO 9611 05820099
586: 29600 IVFAIL = IVFAIL + 1 05830099
587: RVCORR = 0.245 05840099
588: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05850099
589: 9611 CONTINUE 05860099
590: C 05870099
591: C TESTS 961 AND 962 CONTAIN TESTS FOR ARCTANGENT OF THE FORM 05880099
592: C ATAN (A) WHERE THE ARGUMENT AND FUNCTION ARE REAL 05890099
593: C 05900099
594: IVTNUM = 961 05910099
595: C 05920099
596: C **** TEST 961 **** 05930099
597: C 05940099
598: IF (ICZERO) 39610, 9610, 39610 05950099
599: 9610 CONTINUE 05960099
600: RVCOMP = ATAN (0.0) 05970099
601: GO TO 49610 05980099
602: 39610 IVDELE = IVDELE + 1 05990099
603: WRITE (I02,80003) IVTNUM 06000099
604: IF (ICZERO) 49610, 9621, 49610 06010099
605: 49610 IF (RVCOMP + .00005) 29610,19610,49611 06020099
606: 49611 IF (RVCOMP - .00005) 19610,19610,29610 06030099
607: 19610 IVPASS = IVPASS + 1 06040099
608: WRITE (I02,80001) IVTNUM 06050099
609: GO TO 9621 06060099
610: 29610 IVFAIL = IVFAIL + 1 06070099
611: RVCORR = 0.00000 06080099
612: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06090099
613: 9621 CONTINUE 06100099
614: IVTNUM = 962 06110099
615: C 06120099
616: C **** TEST 962 **** 06130099
617: C 06140099
618: IF (ICZERO) 39620, 9620, 39620 06150099
619: 9620 CONTINUE 06160099
620: RVON01 = 5E-1 06170099
621: RVCOMP = ATAN (RVON01) 06180099
622: GO TO 49620 06190099
623: 39620 IVDELE = IVDELE + 1 06200099
624: WRITE (I02,80003) IVTNUM 06210099
625: IF (ICZERO) 49620, 9631, 49620 06220099
626: 49620 IF (RVCOMP - .459) 29620,19620,49621 06230099
627: 49621 IF (RVCOMP - .469) 19620,19620,29620 06240099
628: 19620 IVPASS = IVPASS + 1 06250099
629: WRITE (I02,80001) IVTNUM 06260099
630: GO TO 9631 06270099
631: 29620 IVFAIL = IVFAIL + 1 06280099
632: RVCORR = 0.464 06290099
633: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06300099
634: 9631 CONTINUE 06310099
635: C 06320099
636: C TESTS 963 AND 964 CONTAIN TESTS FOR ARCTANGENT OF THE FORM 06330099
637: C ATAN2 (A1,A2) WHERE THE ARGUMENTS AND FUNCTION ARE REAL 06340099
638: C 06350099
639: IVTNUM = 963 06360099
640: C 06370099
641: C **** TEST 963 **** 06380099
642: C 06390099
643: IF (ICZERO) 39630, 9630, 39630 06400099
644: 9630 CONTINUE 06410099
645: RVON01 = 0.0 06420099
646: RVON02 = 1E0 06430099
647: RVCOMP = ATAN2 (RVON01,RVON02) 06440099
648: GO TO 49630 06450099
649: 39630 IVDELE = IVDELE + 1 06460099
650: WRITE (I02,80003) IVTNUM 06470099
651: IF (ICZERO) 49630, 9641, 49630 06480099
652: 49630 IF (RVCOMP + .00005) 29630,19630,49631 06490099
653: 49631 IF (RVCOMP - .00005) 19630,19630,29630 06500099
654: 19630 IVPASS = IVPASS + 1 06510099
655: WRITE (I02,80001) IVTNUM 06520099
656: GO TO 9641 06530099
657: 29630 IVFAIL = IVFAIL + 1 06540099
658: RVCORR = 0.00000 06550099
659: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06560099
660: 9641 CONTINUE 06570099
661: IVTNUM = 964 06580099
662: C 06590099
663: C **** TEST 964 **** 06600099
664: C 06610099
665: IF (ICZERO) 39640, 9640, 39640 06620099
666: 9640 CONTINUE 06630099
667: RVON01 = 2E1 06640099
668: RVCOMP = ATAN2 (-1.0,RVON01) 06650099
669: GO TO 49640 06660099
670: 39640 IVDELE = IVDELE + 1 06670099
671: WRITE (I02,80003) IVTNUM 06680099
672: IF (ICZERO) 49640, 9651, 49640 06690099
673: 49640 IF (RVCOMP + .05001) 29640,19640,49641 06700099
674: 49641 IF (RVCOMP + .04991) 19640,19640,29640 06710099
675: 19640 IVPASS = IVPASS + 1 06720099
676: WRITE (I02,80001) IVTNUM 06730099
677: GO TO 9651 06740099
678: 29640 IVFAIL = IVFAIL + 1 06750099
679: RVCORR = -.04996 06760099
680: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06770099
681: 9651 CONTINUE 06780099
682: C 06790099
683: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 06800099
684: 99999 CONTINUE 06810099
685: WRITE (I02,90002) 06820099
686: WRITE (I02,90006) 06830099
687: WRITE (I02,90002) 06840099
688: WRITE (I02,90002) 06850099
689: WRITE (I02,90007) 06860099
690: WRITE (I02,90002) 06870099
691: WRITE (I02,90008) IVFAIL 06880099
692: WRITE (I02,90009) IVPASS 06890099
693: WRITE (I02,90010) IVDELE 06900099
694: C 06910099
695: C 06920099
696: C TERMINATE ROUTINE EXECUTION 06930099
697: STOP 06940099
698: C 06950099
699: C FORMAT STATEMENTS FOR PAGE HEADERS 06960099
700: 90000 FORMAT (1H1) 06970099
701: 90002 FORMAT (1H ) 06980099
702: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 06990099
703: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 07000099
704: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 07010099
705: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 07020099
706: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 07030099
707: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 07040099
708: C 07050099
709: C FORMAT STATEMENTS FOR RUN SUMMARIES 07060099
710: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 07070099
711: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 07080099
712: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 07090099
713: C 07100099
714: C FORMAT STATEMENTS FOR TEST RESULTS 07110099
715: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 07120099
716: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 07130099
717: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 07140099
718: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 07150099
719: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 07160099
720: C 07170099
721: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM099) 07180099
722: END 07190099
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.