|
|
1.1 root 1: PROGRAM FM308 00010308
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 00020308
6: C 00030308
7: C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE ACTUAL 00040308
8: C ARGUMENTS CONSIST OF INTRINSIC FUNCTION REFERENCES, EXTERNAL 00050308
9: C FUNCTION REFERENCES, STATEMENT FUNCTION REFERENCES, AND 00060308
10: C EXPRESSIONS INVOLVING OPERATORS. THE ARGUMENT AND FUNCTION 00070308
11: C TYPES OF ALL INTRINSIC FUNCTIONS TESTED ARE EITHER INTEGER OR 00080308
12: C REAL. THE INTRINSIC AND EXTERNAL SPECIFICATION STATEMENTS ARE 00090308
13: C SPECIFIED IN ORDER TO ALLOW INTRINSIC AND EXTERNAL FUNCTIONS TO 00100308
14: C BE USED AS ACTUAL ARGUMENTS. THE IMPLICIT STATEMENT AND THE 00110308
15: C TYPE-STATEMENT ARE TESTED TO ENSURE THAT THEY DO NOT CHANGE THE 00120308
16: C TYPE OF AN INTRINSIC FUNCTION. THE COMMON STATEMENT IS USED TO 00130308
17: C PASS DATA ENTITIES TO AN EXTERNAL FUNCTION. THE DATA STATEMENT 00140308
18: C IS USED TO ENSURE THAT INITIALLY DEFINED ENTITIES CAN BE USED AS 00150308
19: C ACTUAL ARGUMENTS. THE EQUIVALENCE STATEMENT IS USED TO EQUATE A 00160308
20: C VARIABLE USED AS AN ACTUAL ARGUMENT. THE INTRINSIC FUNCTIONS 00170308
21: C TESTED IN THIS ROUTINE INCLUDE. 00180308
22: C 00190308
23: C SPECIFIC TYPE OF 00200308
24: C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION00210308
25: C ------------------ -------- -------- --------00220308
26: C TYPE CONVERSION INT REAL INTEGER 00230308
27: C TYPE CONVERSION IFIX REAL INTEGER 00240308
28: C TYPE CONVERSION FLOAT INTEGER REAL 00250308
29: C TYPE CONVERSION REAL INTEGER REAL 00260308
30: C TRUNCATION AINT REAL REAL 00270308
31: C NEAREST WHOLE NUMBER ANINT REAL REAL 00280308
32: C NEAREST INTEGER NINT REAL INTEGER 00290308
33: C ABSOLUTE VALUE IABS INTEGER INTEGER 00300308
34: C ABSOLUTE VALUE ABS REAL REAL 00310308
35: C REMAINDERING MOD INTEGER INTEGER 00320308
36: C REMAINDERING AMOD REAL REAL 00330308
37: C TRANSFER OF SIGN ISIGN INTEGER INTEGER 00340308
38: C TRANSFER OF SIGN SIGN REAL REAL 00350308
39: C POSITIVE DIFFERENCE IDIM INTEGER INTEGER 00360308
40: C POSITIVE DIFFERENCE DIM REAL REAL 00370308
41: C CHOOSING LARGEST VALUE MAX0 INTEGER INTEGER 00380308
42: C CHOOSING LARGEST VALUE AMAX0 INTEGER REAL 00390308
43: C CHOOSING LARGEST VALUE MAX1 REAL INTEGER 00400308
44: C CHOOSING SMALLEST VALUE AMIN1 REAL REAL 00410308
45: C CHOOSING SMALLEST VALUE MIN1 REAL INTEGER 00420308
46: C SQUARE ROOT SQRT REAL REAL 00430308
47: C EXPONENTIAL EXP REAL REAL 00440308
48: C NATURAL LOGARITHM ALOG REAL REAL 00450308
49: C SINE SIN REAL REAL 00460308
50: C COSINE COS REAL REAL 00470308
51: C TANGENT TAN REAL REAL 00480308
52: C ARCSINE ASIN REAL REAL 00490308
53: C ARCCOSINE ACOS REAL REAL 00500308
54: C ARCTANGENT ATAN REAL REAL 00510308
55: C HYPERBOLIC SINE SINH REAL REAL 00520308
56: C HYPERBOLIC COSINE COSH REAL REAL 00530308
57: C HYPERBOLIC TANGENT TANH REAL REAL 00540308
58: C 00550308
59: C SUBSET LEVEL ROUTINES FM097, FM098, FM099 AND FM307 TEST THE 00560308
60: C USE OF INTEGER AND REAL INTRINSIC FUNCTIONS USING INTEGER AND REAL00570308
61: C CONSTANTS, VARIABLES AND ARRAY ELEMENT ENTITIES AS ACTUAL 00580308
62: C ARGUMENTS. 00590308
63: C 00600308
64: C REFERENCES. 00610308
65: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00620308
66: C X3.9-1978 00630308
67: C 00640308
68: C SECTION 8.2, EQUIVALENCE STATEMENT 00650308
69: C SECTION 8.3, COMMON STATEMENT 00660308
70: C SECTION 8.4, TYPE-STATEMENTS 00670308
71: C SECTION 8.5, IMPLICIT STATEMENT 00680308
72: C SECTION 8.7, EXTERNAL STATEMENT 00690308
73: C SECTION 8.8, INTRINSIC STATEMENT 00700308
74: C SECTION 9, DATA STATEMENT 00710308
75: C SECTION 15.3, INTRINSIC FUNCTION 00720308
76: C SECTION 15.4, STATEMENT FUNCTION 00730308
77: C SECTION 15.5, EXTERNAL FUNCTION 00740308
78: C SECTION 15.5.2, .REFERENCING AN EXTERNAL FUNCTION 00750308
79: C SECTION 15.9.2, ACTUAL ARGUMENTS 00760308
80: C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS 00770308
81: C TABLE 5, INTRINSIC FUNCTIONS (INCLUDING NOTES) 00780308
82: C SECTION 15.10.1, RESTRICTIONS ON RANGE OF ARGUMENTS AND RESULTS00790308
83: C 00800308
84: C 00810308
85: C ******************************************************************00820308
86: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00830308
87: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00840308
88: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00850308
89: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00860308
90: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00870308
91: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00880308
92: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00890308
93: C THE RESULT OF EXECUTING THESE TESTS. 00900308
94: C 00910308
95: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00920308
96: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00930308
97: C 00940308
98: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00950308
99: C DEPARTMENT OF THE NAVY 00960308
100: C FEDERAL COBOL COMPILER TESTING SERVICE 00970308
101: C WASHINGTON, D.C. 20376 00980308
102: C 00990308
103: C ******************************************************************01000308
104: C 01010308
105: C 01020308
106: IMPLICIT LOGICAL (L) 01030308
107: IMPLICIT CHARACTER*14 (C) 01040308
108: C 01050308
109: IMPLICIT INTEGER (E) 01060308
110: IMPLICIT REAL (N) 01070308
111: INTEGER MAX1 01080308
112: REAL SINH 01090308
113: DIMENSION RADN11(5) 01100308
114: DIMENSION IADN11(5) 01110308
115: COMMON RVCN01 01120308
116: EQUIVALENCE (IVOE01,IVOE02) 01130308
117: EXTERNAL FF309,FF310 01140308
118: INTRINSIC ABS, AINT, IABS, ISIGN, SQRT 01150308
119: DATA RVON04/2.23/ 01160308
120: RFOS01(RDON01) = RDON01 + 1.0 01170308
121: C 01180308
122: C 01190308
123: C 01200308
124: C INITIALIZATION SECTION. 01210308
125: C 01220308
126: C INITIALIZE CONSTANTS 01230308
127: C ******************** 01240308
128: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01250308
129: I01 = 5 01260308
130: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01270308
131: I02 = 6 01280308
132: C SYSTEM ENVIRONMENT SECTION 01290308
133: C 01300308
134: I01 = 5 01310308
135: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01320308
136: C (UNIT NUMBER FOR CARD READER). 01330308
137: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01340308
138: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01350308
139: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01360308
140: C 01370308
141: I02 = 6 01380308
142: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01390308
143: C (UNIT NUMBER FOR PRINTER). 01400308
144: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01410308
145: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01420308
146: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01430308
147: C 01440308
148: IVPASS = 0 01450308
149: IVFAIL = 0 01460308
150: IVDELE = 0 01470308
151: ICZERO = 0 01480308
152: C 01490308
153: C WRITE OUT PAGE HEADERS 01500308
154: C 01510308
155: WRITE (I02,90002) 01520308
156: WRITE (I02,90006) 01530308
157: WRITE (I02,90008) 01540308
158: WRITE (I02,90004) 01550308
159: WRITE (I02,90010) 01560308
160: WRITE (I02,90004) 01570308
161: WRITE (I02,90016) 01580308
162: WRITE (I02,90001) 01590308
163: WRITE (I02,90004) 01600308
164: WRITE (I02,90012) 01610308
165: WRITE (I02,90014) 01620308
166: WRITE (I02,90004) 01630308
167: C 01640308
168: C 01650308
169: C TEST 032 THROUGH TEST 040 TEST INTRINSIC FUNCTIONS USING 01660308
170: C INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS. 01670308
171: C 01680308
172: C 01690308
173: C **** FCVS PROGRAM 308 - TEST 032 **** 01700308
174: C 01710308
175: C 01720308
176: IVTNUM = 32 01730308
177: IF (ICZERO) 30320, 0320, 30320 01740308
178: 0320 CONTINUE 01750308
179: RVCOMP = 10.0 01760308
180: RVCOMP = ANINT (ABS (-2.78) ) 01770308
181: RVCORR = 3.0 01780308
182: 40320 IF (RVCOMP - 2.9995) 20320, 10320, 40321 01790308
183: 40321 IF (RVCOMP - 3.0005) 10320, 10320, 20320 01800308
184: 30320 IVDELE = IVDELE + 1 01810308
185: WRITE (I02,80000) IVTNUM 01820308
186: IF (ICZERO) 10320, 0331, 20320 01830308
187: 10320 IVPASS = IVPASS + 1 01840308
188: WRITE (I02,80002) IVTNUM 01850308
189: GO TO 0331 01860308
190: 20320 IVFAIL = IVFAIL + 1 01870308
191: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01880308
192: 0331 CONTINUE 01890308
193: C 01900308
194: C **** FCVS PROGRAM 308 - TEST 033 **** 01910308
195: C 01920308
196: C 01930308
197: IVTNUM = 33 01940308
198: IF (ICZERO) 30330, 0330, 30330 01950308
199: 0330 CONTINUE 01960308
200: RVCOMP = 10.0 01970308
201: RVCOMP = ATAN (AINT (1.2) ) 01980308
202: RVCORR = .78540 01990308
203: 40330 IF (RVCOMP - .78535) 20330, 10330, 40331 02000308
204: 40331 IF (RVCOMP - .78545) 10330, 10330, 20330 02010308
205: 30330 IVDELE = IVDELE + 1 02020308
206: WRITE (I02,80000) IVTNUM 02030308
207: IF (ICZERO) 10330, 0341, 20330 02040308
208: 10330 IVPASS = IVPASS + 1 02050308
209: WRITE (I02,80002) IVTNUM 02060308
210: GO TO 0341 02070308
211: 20330 IVFAIL = IVFAIL + 1 02080308
212: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02090308
213: 0341 CONTINUE 02100308
214: C 02110308
215: C **** FCVS PROGRAM 308 - TEST 034 **** 02120308
216: C 02130308
217: C 02140308
218: IVTNUM = 34 02150308
219: IF (ICZERO) 30340, 0340, 30340 02160308
220: 0340 CONTINUE 02170308
221: RVCOMP = 10.0 02180308
222: RVCOMP = COS (ABS (-.78540) ) 02190308
223: RVCORR = .70711 02200308
224: 40340 IF (RVCOMP - .70706) 20340, 10340, 40341 02210308
225: 40341 IF (RVCOMP - .70716) 10340, 10340, 20340 02220308
226: 30340 IVDELE = IVDELE + 1 02230308
227: WRITE (I02,80000) IVTNUM 02240308
228: IF (ICZERO) 10340, 0351, 20340 02250308
229: 10340 IVPASS = IVPASS + 1 02260308
230: WRITE (I02,80002) IVTNUM 02270308
231: GO TO 0351 02280308
232: 20340 IVFAIL = IVFAIL + 1 02290308
233: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02300308
234: 0351 CONTINUE 02310308
235: C 02320308
236: C **** FCVS PROGRAM 308 - TEST 035 **** 02330308
237: C 02340308
238: C 02350308
239: IVTNUM = 35 02360308
240: IF (ICZERO) 30350, 0350, 30350 02370308
241: 0350 CONTINUE 02380308
242: RVCOMP = 10.0 02390308
243: IVON01 = 6 02400308
244: RVCOMP = AMAX0 (1, IVON01, IABS(-7) ) 02410308
245: RVCORR = 7.0 02420308
246: 40350 IF (RVCOMP - 6.9995) 20350, 10350, 40351 02430308
247: 40351 IF (RVCOMP - 7.0005) 10350, 10350, 20350 02440308
248: 30350 IVDELE = IVDELE + 1 02450308
249: WRITE (I02,80000) IVTNUM 02460308
250: IF (ICZERO) 10350, 0361, 20350 02470308
251: 10350 IVPASS = IVPASS + 1 02480308
252: WRITE (I02,80002) IVTNUM 02490308
253: GO TO 0361 02500308
254: 20350 IVFAIL = IVFAIL + 1 02510308
255: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02520308
256: 0361 CONTINUE 02530308
257: C 02540308
258: C **** FCVS PROGRAM 308 - TEST 036 **** 02550308
259: C 02560308
260: C 02570308
261: IVTNUM = 36 02580308
262: IF (ICZERO) 30360, 0360, 30360 02590308
263: 0360 CONTINUE 02600308
264: IVCOMP = 10 02610308
265: IVCOMP = IABS (ISIGN (7, -2)) 02620308
266: IVCORR = 7 02630308
267: 40360 IF (IVCOMP - 7) 20360, 10360, 20360 02640308
268: 30360 IVDELE = IVDELE + 1 02650308
269: WRITE (I02,80000) IVTNUM 02660308
270: IF (ICZERO) 10360, 0371, 20360 02670308
271: 10360 IVPASS = IVPASS + 1 02680308
272: WRITE (I02,80002) IVTNUM 02690308
273: GO TO 0371 02700308
274: 20360 IVFAIL = IVFAIL + 1 02710308
275: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02720308
276: 0371 CONTINUE 02730308
277: C 02740308
278: C **** FCVS PROGRAM 308 - TEST 037 **** 02750308
279: C 02760308
280: C 02770308
281: IVTNUM = 37 02780308
282: IF (ICZERO) 30370, 0370, 30370 02790308
283: 0370 CONTINUE 02800308
284: IVCOMP = 10 02810308
285: IVCOMP = MOD (5, IABS (-3) ) 02820308
286: IVCORR = 2 02830308
287: 40370 IF (IVCOMP - 2) 20370, 10370, 20370 02840308
288: 30370 IVDELE = IVDELE + 1 02850308
289: WRITE (I02,80000) IVTNUM 02860308
290: IF (ICZERO) 10370, 0381, 20370 02870308
291: 10370 IVPASS = IVPASS + 1 02880308
292: WRITE (I02,80002) IVTNUM 02890308
293: GO TO 0381 02900308
294: 20370 IVFAIL = IVFAIL + 1 02910308
295: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02920308
296: 0381 CONTINUE 02930308
297: C 02940308
298: C **** FCVS PROGRAM 308 - TEST 038 **** 02950308
299: C 02960308
300: C 02970308
301: IVTNUM = 38 02980308
302: IF (ICZERO) 30380, 0380, 30380 02990308
303: 0380 CONTINUE 03000308
304: IVCOMP = 10 03010308
305: IVCOMP = ISIGN (-3, IABS (-5) ) 03020308
306: IVCORR = 3 03030308
307: 40380 IF (IVCOMP - 3) 20380, 10380, 20380 03040308
308: 30380 IVDELE = IVDELE + 1 03050308
309: WRITE (I02,80000) IVTNUM 03060308
310: IF (ICZERO) 10380, 0391, 20380 03070308
311: 10380 IVPASS = IVPASS + 1 03080308
312: WRITE (I02,80002) IVTNUM 03090308
313: GO TO 0391 03100308
314: 20380 IVFAIL = IVFAIL + 1 03110308
315: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03120308
316: 0391 CONTINUE 03130308
317: C 03140308
318: C **** FCVS PROGRAM 308 - TEST 039 **** 03150308
319: C 03160308
320: C REPEAT FUNCTION REFERENCE TWICE IN ONE INTRINSIC FUNCTION 03170308
321: C REFERENCE. 03180308
322: C 03190308
323: IVTNUM = 39 03200308
324: IF (ICZERO) 30390, 0390, 30390 03210308
325: 0390 CONTINUE 03220308
326: IVCOMP = 10 03230308
327: IVCOMP = MAX0 (IABS (-5), IABS (-6) ) 03240308
328: IVCORR = 6 03250308
329: 40390 IF (IVCOMP -6) 20390, 10390, 20390 03260308
330: 30390 IVDELE = IVDELE + 1 03270308
331: WRITE (I02,80000) IVTNUM 03280308
332: IF (ICZERO) 10390, 0401, 20390 03290308
333: 10390 IVPASS = IVPASS + 1 03300308
334: WRITE (I02,80002) IVTNUM 03310308
335: GO TO 0401 03320308
336: 20390 IVFAIL = IVFAIL + 1 03330308
337: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03340308
338: 0401 CONTINUE 03350308
339: C 03360308
340: C **** FCVS PROGRAM 308 - TEST 040 **** 03370308
341: C 03380308
342: C USE INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT TO ITSELF. 03390308
343: C 03400308
344: IVTNUM = 40 03410308
345: IF (ICZERO) 30400, 0400, 30400 03420308
346: 0400 CONTINUE 03430308
347: RVCOMP = 10.0 03440308
348: RVCOMP = SQRT (SQRT (25.) ) 03450308
349: RVCORR = 2.2361 03460308
350: 40400 IF (RVCOMP - 2.2356) 20400, 10400, 40401 03470308
351: 40401 IF (RVCOMP - 2.2366) 10400, 10400, 20400 03480308
352: 30400 IVDELE = IVDELE + 1 03490308
353: WRITE (I02,80000) IVTNUM 03500308
354: IF (ICZERO) 10400, 0411, 20400 03510308
355: 10400 IVPASS = IVPASS + 1 03520308
356: WRITE (I02,80002) IVTNUM 03530308
357: GO TO 0411 03540308
358: 20400 IVFAIL = IVFAIL + 1 03550308
359: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03560308
360: 0411 CONTINUE 03570308
361: C 03580308
362: C TEST 041 THROUGH TEST 045 TEST INTRINSIC FUNCTIONS USING EXTERNAL 03590308
363: C FUNCTION REFERENCES AS ACTUAL ARGUMENTS. 03600308
364: C 03610308
365: C 03620308
366: C **** FCVS PROGRAM 308 - TEST 041 **** 03630308
367: C 03640308
368: C 03650308
369: IVTNUM = 41 03660308
370: IF (ICZERO) 30410, 0410, 30410 03670308
371: 0410 CONTINUE 03680308
372: RVCOMP = 10.0 03690308
373: RVCOMP = ALOG (FF309 (29.0) ) 03700308
374: RVCORR = 3.4012 03710308
375: 40410 IF (RVCOMP - 3.4007) 20410, 10410, 40411 03720308
376: 40411 IF (RVCOMP - 3.4017) 10410, 10410, 20410 03730308
377: 30410 IVDELE = IVDELE + 1 03740308
378: WRITE (I02,80000) IVTNUM 03750308
379: IF (ICZERO) 10410, 0421, 20410 03760308
380: 10410 IVPASS = IVPASS + 1 03770308
381: WRITE (I02,80002) IVTNUM 03780308
382: GO TO 0421 03790308
383: 20410 IVFAIL = IVFAIL + 1 03800308
384: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03810308
385: 0421 CONTINUE 03820308
386: C 03830308
387: C **** FCVS PROGRAM 308 - TEST 042 **** 03840308
388: C 03850308
389: C 03860308
390: IVTNUM = 42 03870308
391: IF (ICZERO) 30420, 0420, 30420 03880308
392: 0420 CONTINUE 03890308
393: RVCOMP = 10.0 03900308
394: RVCOMP = ASIN (FF309 (0.) ) 03910308
395: RVCORR = 1.5708 03920308
396: 40420 IF (RVCOMP - 1.5703) 20420, 10420, 40421 03930308
397: 40421 IF (RVCOMP - 1.5713) 10420, 10420, 20420 03940308
398: 30420 IVDELE = IVDELE + 1 03950308
399: WRITE (I02,80000) IVTNUM 03960308
400: IF (ICZERO) 10420, 0431, 20420 03970308
401: 10420 IVPASS = IVPASS + 1 03980308
402: WRITE (I02,80002) IVTNUM 03990308
403: GO TO 0431 04000308
404: 20420 IVFAIL = IVFAIL + 1 04010308
405: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04020308
406: 0431 CONTINUE 04030308
407: C 04040308
408: C **** FCVS PROGRAM 308 - TEST 043 **** 04050308
409: C 04060308
410: C 04070308
411: IVTNUM = 43 04080308
412: IF (ICZERO) 30430, 0430, 30430 04090308
413: 0430 CONTINUE 04100308
414: RVCOMP = 10.0 04110308
415: RVON01 = 1.5 04120308
416: RVCOMP = COSH (FF309 (RVON01) ) 04130308
417: RVCORR = 6.1323 04140308
418: 40430 IF (RVCOMP - 6.1318) 20430, 10430, 40431 04150308
419: 40431 IF (RVCOMP - 6.1328) 10430, 10430, 20430 04160308
420: 30430 IVDELE = IVDELE + 1 04170308
421: WRITE (I02,80000) IVTNUM 04180308
422: IF (ICZERO) 10430, 0441, 20430 04190308
423: 10430 IVPASS = IVPASS + 1 04200308
424: WRITE (I02,80002) IVTNUM 04210308
425: GO TO 0441 04220308
426: 20430 IVFAIL = IVFAIL + 1 04230308
427: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04240308
428: 0441 CONTINUE 04250308
429: C 04260308
430: C **** FCVS PROGRAM 308 - TEST 044 **** 04270308
431: C 04280308
432: C 04290308
433: IVTNUM = 44 04300308
434: IF (ICZERO) 30440, 0440, 30440 04310308
435: 0440 CONTINUE 04320308
436: IVCOMP = 10 04330308
437: IVCOMP = IFIX (FF309 (33.3) ) 04340308
438: IVCORR = 34 04350308
439: 40440 IF (IVCOMP - 34) 20440, 10440, 20440 04360308
440: 30440 IVDELE = IVDELE + 1 04370308
441: WRITE (I02,80000) IVTNUM 04380308
442: IF (ICZERO) 10440, 0451, 20440 04390308
443: 10440 IVPASS = IVPASS + 1 04400308
444: WRITE (I02,80002) IVTNUM 04410308
445: GO TO 0451 04420308
446: 20440 IVFAIL = IVFAIL + 1 04430308
447: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04440308
448: 0451 CONTINUE 04450308
449: C 04460308
450: C **** FCVS PROGRAM 308 - TEST 045 **** 04470308
451: C 04480308
452: C 04490308
453: IVTNUM = 45 04500308
454: IF (ICZERO) 30450, 0450, 30450 04510308
455: 0450 CONTINUE 04520308
456: RVCOMP = 10.0 04530308
457: RADN11(2) = 2.1416 04540308
458: RVCOMP = TAN (FF309 (RADN11(2))) 04550308
459: RVCORR = 0.0 04560308
460: 40450 IF (RVCOMP + .00005) 20450, 10450, 40451 04570308
461: 40451 IF (RVCOMP - .00005) 10450, 10450, 20450 04580308
462: 30450 IVDELE = IVDELE + 1 04590308
463: WRITE (I02,80000) IVTNUM 04600308
464: IF (ICZERO) 10450, 0461, 20450 04610308
465: 10450 IVPASS = IVPASS + 1 04620308
466: WRITE (I02,80002) IVTNUM 04630308
467: GO TO 0461 04640308
468: 20450 IVFAIL = IVFAIL + 1 04650308
469: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04660308
470: 0461 CONTINUE 04670308
471: C 04680308
472: C TEST 046 THROUGH TEST 052 TEST INTRINSIC FUNCTIONS USING 04690308
473: C EXPRESSIONS INVOLVING OPERATORS AS ACTUAL ARGUMENTS. 04700308
474: C 04710308
475: C 04720308
476: C **** FCVS PROGRAM 308 - TEST 046 **** 04730308
477: C 04740308
478: C 04750308
479: IVTNUM = 46 04760308
480: IF (ICZERO) 30460, 0460, 30460 04770308
481: 0460 CONTINUE 04780308
482: RVCOMP = 10.0 04790308
483: RVCOMP = ABS (3.4 - 8.2) 04800308
484: RVCORR = 4.8 04810308
485: 40460 IF (RVCOMP - 4.7995) 20460, 10460, 40461 04820308
486: 40461 IF (RVCOMP - 4.8005) 10460, 10460, 20460 04830308
487: 30460 IVDELE = IVDELE + 1 04840308
488: WRITE (I02,80000) IVTNUM 04850308
489: IF (ICZERO) 10460, 0471, 20460 04860308
490: 10460 IVPASS = IVPASS + 1 04870308
491: WRITE (I02,80002) IVTNUM 04880308
492: GO TO 0471 04890308
493: 20460 IVFAIL = IVFAIL + 1 04900308
494: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04910308
495: 0471 CONTINUE 04920308
496: C 04930308
497: C **** FCVS PROGRAM 308 - TEST 047 **** 04940308
498: C 04950308
499: C 04960308
500: IVTNUM = 47 04970308
501: IF (ICZERO) 30470, 0470, 30470 04980308
502: 0470 CONTINUE 04990308
503: RVCOMP = 10.0 05000308
504: IVON01 = 2 05010308
505: RVON01 = 3.0 05020308
506: RVCOMP = ACOS (IVON01 - RVON01 * .5) 05030308
507: RVCORR = 1.0472 05040308
508: 40470 IF (RVCOMP - 1.0467) 20470, 10470, 40471 05050308
509: 40471 IF (RVCOMP - 1.0477) 10470, 10470, 20470 05060308
510: 30470 IVDELE = IVDELE + 1 05070308
511: WRITE (I02,80000) IVTNUM 05080308
512: IF (ICZERO) 10470, 0481, 20470 05090308
513: 10470 IVPASS = IVPASS + 1 05100308
514: WRITE (I02,80002) IVTNUM 05110308
515: GO TO 0481 05120308
516: 20470 IVFAIL = IVFAIL + 1 05130308
517: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05140308
518: 0481 CONTINUE 05150308
519: C 05160308
520: C **** FCVS PROGRAM 308 - TEST 048 **** 05170308
521: C 05180308
522: C 05190308
523: IVTNUM = 48 05200308
524: IF (ICZERO) 30480, 0480, 30480 05210308
525: 0480 CONTINUE 05220308
526: RVCOMP = 10.0 05230308
527: IVON01 = 2 05240308
528: RVON01 = -4.8 05250308
529: RVON02 = 4.5 05260308
530: RVCOMP = AMIN1 (RVON01, (IVON01 - 3.2) * RVON02) 05270308
531: RVCORR = -5.4 05280308
532: 40480 IF (RVCOMP + 5.4005 ) 20480, 10480, 40481 05290308
533: 40481 IF (RVCOMP + 5.3995 ) 10480, 10480, 20480 05300308
534: 30480 IVDELE = IVDELE + 1 05310308
535: WRITE (I02,80000) IVTNUM 05320308
536: IF (ICZERO) 10480, 0491, 20480 05330308
537: 10480 IVPASS = IVPASS + 1 05340308
538: WRITE (I02,80002) IVTNUM 05350308
539: GO TO 0491 05360308
540: 20480 IVFAIL = IVFAIL + 1 05370308
541: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05380308
542: 0491 CONTINUE 05390308
543: C 05400308
544: C **** FCVS PROGRAM 308 - TEST 049 **** 05410308
545: C 05420308
546: C 05430308
547: IVTNUM = 49 05440308
548: IF (ICZERO) 30490, 0490, 30490 05450308
549: 0490 CONTINUE 05460308
550: RVCOMP = 10.0 05470308
551: RVON01 = 12.0 05480308
552: IADN11(1) = 3 05490308
553: RADN11(2) = 2.5 05500308
554: RVCOMP = AMOD (RVON01 / IADN11(1), 12 / RADN11(2)) 05510308
555: RVCORR = 4.0 05520308
556: 40490 IF (RVCOMP - 3.9995) 20490, 10490, 40491 05530308
557: 40491 IF (RVCOMP - 4.0005) 10490, 10490, 20490 05540308
558: 30490 IVDELE = IVDELE + 1 05550308
559: WRITE (I02,80000) IVTNUM 05560308
560: IF (ICZERO) 10490, 0501, 20490 05570308
561: 10490 IVPASS = IVPASS + 1 05580308
562: WRITE (I02,80002) IVTNUM 05590308
563: GO TO 0501 05600308
564: 20490 IVFAIL = IVFAIL + 1 05610308
565: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05620308
566: 0501 CONTINUE 05630308
567: C 05640308
568: C **** FCVS PROGRAM 308 - TEST 050 **** 05650308
569: C 05660308
570: C 05670308
571: IVTNUM = 50 05680308
572: IF (ICZERO) 30500, 0500, 30500 05690308
573: 0500 CONTINUE 05700308
574: IVCOMP = 10 05710308
575: IVON01 = 2 05720308
576: IVON02 = 9 05730308
577: IVCOMP = IDIM (IVON01 ** 3, IVON02) 05740308
578: IVCORR = 0 05750308
579: 40500 IF (IVCOMP) 20500, 10500, 20500 05760308
580: 30500 IVDELE = IVDELE + 1 05770308
581: WRITE (I02,80000) IVTNUM 05780308
582: IF (ICZERO) 10500, 0511, 20500 05790308
583: 10500 IVPASS = IVPASS + 1 05800308
584: WRITE (I02,80002) IVTNUM 05810308
585: GO TO 0511 05820308
586: 20500 IVFAIL = IVFAIL + 1 05830308
587: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05840308
588: 0511 CONTINUE 05850308
589: C 05860308
590: C **** FCVS PROGRAM 308 - TEST 051 **** 05870308
591: C 05880308
592: C 05890308
593: IVTNUM = 51 05900308
594: IF (ICZERO) 30510, 0510, 30510 05910308
595: 0510 CONTINUE 05920308
596: RVCOMP = 10.0 05930308
597: IVON01 = 6 05940308
598: RVCOMP = REAL (IABS (-3) + IVON01) 05950308
599: RVCORR = 9.0 05960308
600: 40510 IF (RVCOMP - 8.9995) 20510, 10510, 40511 05970308
601: 40511 IF (RVCOMP - 9.0005) 10510, 10510, 20510 05980308
602: 30510 IVDELE = IVDELE + 1 05990308
603: WRITE (I02,80000) IVTNUM 06000308
604: IF (ICZERO) 10510, 0521, 20510 06010308
605: 10510 IVPASS = IVPASS + 1 06020308
606: WRITE (I02,80002) IVTNUM 06030308
607: GO TO 0521 06040308
608: 20510 IVFAIL = IVFAIL + 1 06050308
609: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06060308
610: 0521 CONTINUE 06070308
611: C 06080308
612: C **** FCVS PROGRAM 308 - TEST 052 **** 06090308
613: C 06100308
614: C 06110308
615: IVTNUM = 52 06120308
616: IF (ICZERO) 30520, 0520, 30520 06130308
617: 0520 CONTINUE 06140308
618: RVCOMP = 10.0 06150308
619: RVON01 = 2.3 06160308
620: IVON01 = 150 06170308
621: IADN11(1) = 3 06180308
622: RVCOMP = SIGN(13+RVON01*IABS(-4)-IVON01/FF309(1.)**IADN11(1),-1.) 06190308
623: RVCORR = -3.45 06200308
624: 40520 IF (RVCOMP + 3.4505) 20520, 10520, 40521 06210308
625: 40521 IF (RVCOMP + 3.4495) 10520, 10520, 20520 06220308
626: 30520 IVDELE = IVDELE + 1 06230308
627: WRITE (I02,80000) IVTNUM 06240308
628: IF (ICZERO) 10520, 0531, 20520 06250308
629: 10520 IVPASS = IVPASS + 1 06260308
630: WRITE (I02,80002) IVTNUM 06270308
631: GO TO 0531 06280308
632: 20520 IVFAIL = IVFAIL + 1 06290308
633: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06300308
634: 0531 CONTINUE 06310308
635: C 06320308
636: C TEST 053 THROUGH TEST 056 TEST INTRINSIC FUNCTIONS USING 06330308
637: C STATEMENT FUNCTION REFERENCES AS ACTUAL ARGUMENTS. 06340308
638: C 06350308
639: C 06360308
640: C **** FCVS PROGRAM 308 - TEST 053 **** 06370308
641: C 06380308
642: C 06390308
643: IVTNUM = 53 06400308
644: IF (ICZERO) 30530, 0530, 30530 06410308
645: 0530 CONTINUE 06420308
646: RVCOMP = 10.0 06430308
647: RVCOMP = DIM (RFOS01(5.4), 6.0) 06440308
648: RVCORR = .4 06450308
649: 40530 IF (RVCOMP - .39995) 20530, 10530, 40531 06460308
650: 40531 IF (RVCOMP - .40005) 10530, 10530, 20530 06470308
651: 30530 IVDELE = IVDELE + 1 06480308
652: WRITE (I02,80000) IVTNUM 06490308
653: IF (ICZERO) 10530, 0541, 20530 06500308
654: 10530 IVPASS = IVPASS + 1 06510308
655: WRITE (I02,80002) IVTNUM 06520308
656: GO TO 0541 06530308
657: 20530 IVFAIL = IVFAIL + 1 06540308
658: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06550308
659: 0541 CONTINUE 06560308
660: C 06570308
661: C **** FCVS PROGRAM 308 - TEST 054 **** 06580308
662: C 06590308
663: C 06600308
664: IVTNUM = 54 06610308
665: IF (ICZERO) 30540, 0540, 30540 06620308
666: 0540 CONTINUE 06630308
667: IVCOMP = 10 06640308
668: IVCOMP = INT(RFOS01(2.01)) 06650308
669: IVCORR = 3 06660308
670: 40540 IF (IVCOMP - 3) 20540, 10540, 20540 06670308
671: 30540 IVDELE = IVDELE + 1 06680308
672: WRITE (I02,80000) IVTNUM 06690308
673: IF (ICZERO) 10540, 0551, 20540 06700308
674: 10540 IVPASS = IVPASS + 1 06710308
675: WRITE (I02,80002) IVTNUM 06720308
676: GO TO 0551 06730308
677: 20540 IVFAIL = IVFAIL + 1 06740308
678: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06750308
679: 0551 CONTINUE 06760308
680: C 06770308
681: C **** FCVS PROGRAM 308 - TEST 055 **** 06780308
682: C 06790308
683: C 06800308
684: IVTNUM = 55 06810308
685: IF (ICZERO) 30550, 0550, 30550 06820308
686: 0550 CONTINUE 06830308
687: RVCOMP = 10.0 06840308
688: RVON01 = 0.5708 06850308
689: RVCOMP = SIN (RFOS01 (RVON01) / 2) 06860308
690: RVCORR = .70711 06870308
691: 40550 IF (RVCOMP - .70706) 20550, 10550, 40551 06880308
692: 40551 IF (RVCOMP - .70716) 10550, 10550, 20550 06890308
693: 30550 IVDELE = IVDELE + 1 06900308
694: WRITE (I02,80000) IVTNUM 06910308
695: IF (ICZERO) 10550, 0561, 20550 06920308
696: 10550 IVPASS = IVPASS + 1 06930308
697: WRITE (I02,80002) IVTNUM 06940308
698: GO TO 0561 06950308
699: 20550 IVFAIL = IVFAIL + 1 06960308
700: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06970308
701: 0561 CONTINUE 06980308
702: C 06990308
703: C **** FCVS PROGRAM 308 - TEST 056 **** 07000308
704: C 07010308
705: C 07020308
706: IVTNUM = 56 07030308
707: IF (ICZERO) 30560, 0560, 30560 07040308
708: 0560 CONTINUE 07050308
709: RVCOMP = 10.0 07060308
710: RADN11(2) = 1.5 07070308
711: RVCOMP = TANH(RFOS01(RADN11(2))) 07080308
712: RVCORR = .98661 07090308
713: 40560 IF (RVCOMP - .98656) 20560, 10560, 40561 07100308
714: 40561 IF (RVCOMP - .98666) 10560, 10560, 20560 07110308
715: 30560 IVDELE = IVDELE + 1 07120308
716: WRITE (I02,80000) IVTNUM 07130308
717: IF (ICZERO) 10560, 0571, 20560 07140308
718: 10560 IVPASS = IVPASS + 1 07150308
719: WRITE (I02,80002) IVTNUM 07160308
720: GO TO 0571 07170308
721: 20560 IVFAIL = IVFAIL + 1 07180308
722: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07190308
723: 0571 CONTINUE 07200308
724: C 07210308
725: C **** FCVS PROGRAM 308 - TEST 057 **** 07220308
726: C 07230308
727: C TEST 057 TESTS THE INTRINSIC FUNCTION AINT USING AN EXTERNAL 07240308
728: C FUNCTION REFERENCE AS AN ACTUAL ARGUMENT AND THE COMMON 07250308
729: C STATEMENT AS A MEANS OF PASSING DATA TO THE EXTERNAL FUNCTION. 07260308
730: C 07270308
731: IVTNUM = 57 07280308
732: IF (ICZERO) 30570, 0570, 30570 07290308
733: 0570 CONTINUE 07300308
734: RVCOMP = 10.0 07310308
735: RVCN01 = 25.3 07320308
736: RVCOMP = AINT(FF310( )) 07330308
737: RVCORR = 26.0 07340308
738: 40570 IF (RVCOMP - 25.995) 20570, 10570, 40571 07350308
739: 40571 IF (RVCOMP - 26.005) 10570, 10570, 20570 07360308
740: 30570 IVDELE = IVDELE + 1 07370308
741: WRITE (I02,80000) IVTNUM 07380308
742: IF (ICZERO) 10570, 0581, 20570 07390308
743: 10570 IVPASS = IVPASS + 1 07400308
744: WRITE (I02,80002) IVTNUM 07410308
745: GO TO 0581 07420308
746: 20570 IVFAIL = IVFAIL + 1 07430308
747: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07440308
748: 0581 CONTINUE 07450308
749: C 07460308
750: C **** FCVS PROGRAM 308 - TEST 058 **** 07470308
751: C 07480308
752: C TEST 058 TESTS THE INTRINSIC FUNCTION FLOAT BY USING A VARIABLE 07490308
753: C EQUATED BY EQUIVALENCE ASSOCIATION AS AN ACTUAL ARGUMENT. 07500308
754: C 07510308
755: IVTNUM = 58 07520308
756: IF (ICZERO) 30580, 0580, 30580 07530308
757: 0580 CONTINUE 07540308
758: RVCOMP = 10.0 07550308
759: IVOE01 = 5 07560308
760: RVCOMP = FLOAT(IVOE01) 07570308
761: RVCORR = 5.0 07580308
762: 40580 IF (RVCOMP - 4.9995) 20580, 10580, 40581 07590308
763: 40581 IF (RVCOMP - 5.0005) 10580, 10580, 20580 07600308
764: 30580 IVDELE = IVDELE + 1 07610308
765: WRITE (I02,80000) IVTNUM 07620308
766: IF (ICZERO) 10580, 0591, 20580 07630308
767: 10580 IVPASS = IVPASS + 1 07640308
768: WRITE (I02,80002) IVTNUM 07650308
769: GO TO 0591 07660308
770: 20580 IVFAIL = IVFAIL + 1 07670308
771: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07680308
772: 0591 CONTINUE 07690308
773: C 07700308
774: C **** FCVS PROGRAM 308 - TEST 059 **** 07710308
775: C 07720308
776: C TEST 059 TESTS THE INTRINSIC FUNCTION MIN1 BY USING A VARIABLE 07730308
777: C INITIALIZED BY THE DATA STATEMENT AS AN ACTUAL ARGUMENT. 07740308
778: C 07750308
779: IVTNUM = 59 07760308
780: IF (ICZERO) 30590, 0590, 30590 07770308
781: 0590 CONTINUE 07780308
782: IVCOMP = 10 07790308
783: IVCOMP = MIN1(6., RVON04, 7.3) 07800308
784: IVCORR = 2 07810308
785: 40590 IF (IVCOMP - 2) 20590, 10590, 20590 07820308
786: 30590 IVDELE = IVDELE + 1 07830308
787: WRITE (I02,80000) IVTNUM 07840308
788: IF (ICZERO) 10590, 0601, 20590 07850308
789: 10590 IVPASS = IVPASS + 1 07860308
790: WRITE (I02,80002) IVTNUM 07870308
791: GO TO 0601 07880308
792: 20590 IVFAIL = IVFAIL + 1 07890308
793: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07900308
794: 0601 CONTINUE 07910308
795: C 07920308
796: C **** FCVS PROGRAM 308 - TEST 060 **** 07930308
797: C 07940308
798: C TEST 060 ATTEMPTS TO OVERRIDE THE TYPING OF REAL FOR THE 07950308
799: C INTRINSIC FUNCTION EXP WITH IMPLICIT INTEGER TYPING. 07960308
800: C 07970308
801: IVTNUM = 60 07980308
802: IF (ICZERO) 30600, 0600, 30600 07990308
803: 0600 CONTINUE 08000308
804: RVCOMP = 10.0 08010308
805: RVON01 = 2.05 08020308
806: RVCOMP = EXP(RVON01) 08030308
807: RVCORR = 7.7679 08040308
808: 40600 IF (RVCOMP - 7.7674) 20600, 10600, 40601 08050308
809: 40601 IF (RVCOMP - 7.7684) 10600, 10600, 20600 08060308
810: 30600 IVDELE = IVDELE + 1 08070308
811: WRITE (I02,80000) IVTNUM 08080308
812: IF (ICZERO) 10600, 0611, 20600 08090308
813: 10600 IVPASS = IVPASS + 1 08100308
814: WRITE (I02,80002) IVTNUM 08110308
815: GO TO 0611 08120308
816: 20600 IVFAIL = IVFAIL + 1 08130308
817: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08140308
818: 0611 CONTINUE 08150308
819: C 08160308
820: C **** FCVS PROGRAM 308 - TEST 061 **** 08170308
821: C 08180308
822: C TEST 061 ATTEMPTS TO OVERRIDE THE TYPING OF INTEGER FOR THE 08190308
823: C INTRINSIC FUNCTION NINT WITH IMPLICIT REAL TYPING. 08200308
824: C 08210308
825: IVTNUM = 61 08220308
826: IF (ICZERO) 30610, 0610, 30610 08230308
827: 0610 CONTINUE 08240308
828: RVCOMP = 10.0 08250308
829: RVON01 = 3.78 08260308
830: RVCOMP = NINT(RVON01) / 5 08270308
831: RVCORR = 0.0 08280308
832: 40610 IF (RVCOMP + .00005) 20610, 10610, 40611 08290308
833: 40611 IF (RVCOMP - .00005) 10610, 10610, 20610 08300308
834: 30610 IVDELE = IVDELE + 1 08310308
835: WRITE (I02,80000) IVTNUM 08320308
836: IF (ICZERO) 10610, 0621, 20610 08330308
837: 10610 IVPASS = IVPASS + 1 08340308
838: WRITE (I02,80002) IVTNUM 08350308
839: GO TO 0621 08360308
840: 20610 IVFAIL = IVFAIL + 1 08370308
841: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08380308
842: 0621 CONTINUE 08390308
843: C 08400308
844: C **** FCVS PROGRAM 308 - TEST 062 **** 08410308
845: C 08420308
846: C TEST 062 ATTEMPTS TO OVERRIDE THE TYPING OF REAL FOR THE 08430308
847: C INTRINSIC FUNCTION SINH WITH TYPE-STATEMENT TYPING OF INTEGER. 08440308
848: C 08450308
849: IVTNUM = 62 08460308
850: IF (ICZERO) 30620, 0620, 30620 08470308
851: 0620 CONTINUE 08480308
852: RVCOMP = 10.0 08490308
853: RVCOMP = SINH(2.0) 08500308
854: RVCORR = 3.6269 08510308
855: 40620 IF (RVCOMP - 3.6264) 20620, 10620, 40621 08520308
856: 40621 IF (RVCOMP - 3.6274) 10620, 10620, 20620 08530308
857: 30620 IVDELE = IVDELE + 1 08540308
858: WRITE (I02,80000) IVTNUM 08550308
859: IF (ICZERO) 10620, 0631, 20620 08560308
860: 10620 IVPASS = IVPASS + 1 08570308
861: WRITE (I02,80002) IVTNUM 08580308
862: GO TO 0631 08590308
863: 20620 IVFAIL = IVFAIL + 1 08600308
864: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08610308
865: 0631 CONTINUE 08620308
866: C 08630308
867: C **** FCVS PROGRAM 308 - TEST 063 **** 08640308
868: C 08650308
869: C TEST 063 ATTEMPTS TO OVERRIDE THE TYPING OF INTEGER FOR THE 08660308
870: C INTRINSIC FUNCTION MAX1 WITH TYPE-STATEMENT TYPING OF REAL. 08670308
871: C 08680308
872: IVTNUM = 63 08690308
873: IF (ICZERO) 30630, 0630, 30630 08700308
874: 0630 CONTINUE 08710308
875: RVCOMP = 10.0 08720308
876: RVCOMP = MAX1(2.3, 3.1, 4.4) / 5 08730308
877: RVCORR = 0.0 08740308
878: 40630 IF (RVCOMP + .00005) 20630, 10630, 40631 08750308
879: 40631 IF (RVCOMP - .00005) 10630, 10630, 20630 08760308
880: 30630 IVDELE = IVDELE + 1 08770308
881: WRITE (I02,80000) IVTNUM 08780308
882: IF (ICZERO) 10630, 0641, 20630 08790308
883: 10630 IVPASS = IVPASS + 1 08800308
884: WRITE (I02,80002) IVTNUM 08810308
885: GO TO 0641 08820308
886: 20630 IVFAIL = IVFAIL + 1 08830308
887: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08840308
888: 0641 CONTINUE 08850308
889: C 08860308
890: C 08870308
891: C WRITE OUT TEST SUMMARY 08880308
892: C 08890308
893: WRITE (I02,90004) 08900308
894: WRITE (I02,90014) 08910308
895: WRITE (I02,90004) 08920308
896: WRITE (I02,90000) 08930308
897: WRITE (I02,90004) 08940308
898: WRITE (I02,90020) IVFAIL 08950308
899: WRITE (I02,90022) IVPASS 08960308
900: WRITE (I02,90024) IVDELE 08970308
901: STOP 08980308
902: 90001 FORMAT (1H ,24X,5HFM308) 08990308
903: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM308) 09000308
904: C 09010308
905: C FORMATS FOR TEST DETAIL LINES 09020308
906: C 09030308
907: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 09040308
908: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 09050308
909: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 09060308
910: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 09070308
911: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 09080308
912: C 09090308
913: C FORMAT STATEMENTS FOR PAGE HEADERS 09100308
914: C 09110308
915: 90002 FORMAT (1H1) 09120308
916: 90004 FORMAT (1H ) 09130308
917: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 09140308
918: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 09150308
919: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 09160308
920: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 09170308
921: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 09180308
922: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 09190308
923: C 09200308
924: C FORMAT STATEMENTS FOR RUN SUMMARY 09210308
925: C 09220308
926: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 09230308
927: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 09240308
928: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 09250308
929: END 09260308
930: REAL FUNCTION FF309(RDON01) 00010309
931: C DATE***82/08/02*18.33.46
932: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
933: C AUDIT FCVS78 V2.0
934: C THIS FUNCTION IS USED TO INCREMENT THE ARGUMENT VALUE BY 00020309
935: C ONE AND RETURN THE RESULT AS THE FUNCTION VALUE. 00030309
936: FF309 = RDON01 + 1.0 00040309
937: RETURN 00050309
938: END 00060309
939: REAL FUNCTION FF310 ( ) 00010310
940: C DATE***82/08/02*18.33.46
941: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
942: C AUDIT FCVS78 V2.0
943: C THIS FUNCTION IS USED TO INCREMENT BY ONE A VALUE PASSED 00020310
944: C TO THE FUNCTION THROUGH COMMON. 00030310
945: COMMON RVCN01 00040310
946: FF310 = RVCN01 + 1.0 00050310
947: RETURN 00060310
948: END 00070310
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.