![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM098.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests|
Return to FM098.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 00010098
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 00020098
6: C FM098 00030098
7: C 00040098
8: C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION TYPE IS 00050098
9: C INTEGER AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE REAL 00060098
10: C AND INTEGER VARIABLES AND THE REAL AND INTEGER CONSTANTS CONTAIN 00070098
11: C BOTH POSITIVE AND NEGATIVE VALUES. THE INTRINSIC FUNCTIONS TESTED00080098
12: C BY FM098 INCLUDE 00090098
13: C TYPE OF 00100098
14: C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION 00110098
15: C ------------------ ---- -------- -------- 00120098
16: C ABSOLUTE VALUE IABS INTEGER INTEGER 00130098
17: C TRUNCATION INT REAL INTEGER 00140098
18: C REMAINDERING MOD INTEGER INTEGER 00150098
19: C CHOOSING LARGEST VALUE MAX0 INTEGER INTEGER 00160098
20: C MAX1 REAL INTEGER 00170098
21: C CHOOSING SMALLEST VALUE MIN0 INTEGER INTEGER 00180098
22: C MIN1 REAL INTEGER 00190098
23: C FIX IFIX REAL INTEGER 00200098
24: C TRANSFER OF SIGN ISIGN INTEGER INTEGER 00210098
25: C POSITIVE DIFFERENCE IDIM INTEGER INTEGER 00220098
26: C 00230098
27: C REFERENCES 00240098
28: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00250098
29: C X3.9-1978 00260098
30: C 00270098
31: C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS 00280098
32: C SECTION 15.3, INTRINSIC FUNCTION 00290098
33: C SECTION 15.3.2, INTRINSIC FUNCTIONS AND THEIR REFERENCE 00300098
34: C 00310098
35: C 00320098
36: C ********************************************************** 00330098
37: C 00340098
38: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00350098
39: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00360098
40: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00370098
41: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00380098
42: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00390098
43: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00400098
44: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00410098
45: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00420098
46: C OF EXECUTING THESE TESTS. 00430098
47: C 00440098
48: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00450098
49: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00460098
50: C 00470098
51: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00480098
52: C 00490098
53: C DEPARTMENT OF THE NAVY 00500098
54: C FEDERAL COBOL COMPILER TESTING SERVICE 00510098
55: C WASHINGTON, D.C. 20376 00520098
56: C 00530098
57: C ********************************************************** 00540098
58: C 00550098
59: C 00560098
60: C 00570098
61: C INITIALIZATION SECTION 00580098
62: C 00590098
63: C INITIALIZE CONSTANTS 00600098
64: C ************** 00610098
65: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620098
66: I01 = 5 00630098
67: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640098
68: I02 = 6 00650098
69: C SYSTEM ENVIRONMENT SECTION 00660098
70: C 00670098
71: I01 = 5 00680098
72: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690098
73: C (UNIT NUMBER FOR CARD READER). 00700098
74: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00710098
75: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00720098
76: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00730098
77: C 00740098
78: I02 = 6 00750098
79: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00760098
80: C (UNIT NUMBER FOR PRINTER). 00770098
81: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00780098
82: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00790098
83: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00800098
84: C 00810098
85: IVPASS=0 00820098
86: IVFAIL=0 00830098
87: IVDELE=0 00840098
88: ICZERO=0 00850098
89: C 00860098
90: C WRITE PAGE HEADERS 00870098
91: WRITE (I02,90000) 00880098
92: WRITE (I02,90001) 00890098
93: WRITE (I02,90002) 00900098
94: WRITE (I02, 90002) 00910098
95: WRITE (I02,90003) 00920098
96: WRITE (I02,90002) 00930098
97: WRITE (I02,90004) 00940098
98: WRITE (I02,90002) 00950098
99: WRITE (I02,90011) 00960098
100: WRITE (I02,90002) 00970098
101: WRITE (I02,90002) 00980098
102: WRITE (I02,90005) 00990098
103: WRITE (I02,90006) 01000098
104: WRITE (I02,90002) 01010098
105: C 01020098
106: C TEST SECTION 01030098
107: C 01040098
108: C TEST 907 THROUGH TEST 909 CONTAIN INTRINSIC FUNCTION TESTS FOR 01050098
109: C ABSOLUTE VALUE WHERE ARGUMENT AND FUNCTION ARE INTEGER 01060098
110: C 01070098
111: 9071 CONTINUE 01080098
112: IVTNUM = 907 01090098
113: C 01100098
114: C **** TEST 907 **** 01110098
115: C 01120098
116: IF (ICZERO) 39070, 9070, 39070 01130098
117: 9070 CONTINUE 01140098
118: IVCOMP = IABS (-382) 01150098
119: GO TO 49070 01160098
120: 39070 IVDELE = IVDELE + 1 01170098
121: WRITE (I02,80003) IVTNUM 01180098
122: IF (ICZERO) 49070, 9081, 49070 01190098
123: 49070 IF (IVCOMP - 382) 29070,19070,29070 01200098
124: 19070 IVPASS = IVPASS + 1 01210098
125: WRITE (I02,80001) IVTNUM 01220098
126: GO TO 9081 01230098
127: 29070 IVFAIL = IVFAIL + 1 01240098
128: IVCORR = 382 01250098
129: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01260098
130: 9081 CONTINUE 01270098
131: IVTNUM = 908 01280098
132: C 01290098
133: C **** TEST 908 **** 01300098
134: C 01310098
135: IF (ICZERO) 39080, 9080, 39080 01320098
136: 9080 CONTINUE 01330098
137: IVON01 = 445 01340098
138: IVCOMP = IABS (IVON01) 01350098
139: GO TO 49080 01360098
140: 39080 IVDELE = IVDELE + 1 01370098
141: WRITE (I02,80003) IVTNUM 01380098
142: IF (ICZERO) 49080, 9091, 49080 01390098
143: 49080 IF (IVCOMP - 445) 29080,19080,29080 01400098
144: 19080 IVPASS = IVPASS + 1 01410098
145: WRITE (I02,80001) IVTNUM 01420098
146: GO TO 9091 01430098
147: 29080 IVFAIL = IVFAIL + 1 01440098
148: IVCORR = 445 01450098
149: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01460098
150: 9091 CONTINUE 01470098
151: IVTNUM = 909 01480098
152: C 01490098
153: C **** TEST 909 **** 01500098
154: C 01510098
155: IF (ICZERO) 39090, 9090, 39090 01520098
156: 9090 CONTINUE 01530098
157: IVON01 = -32176 01540098
158: IVCOMP = IABS (IVON01) 01550098
159: GO TO 49090 01560098
160: 39090 IVDELE = IVDELE + 1 01570098
161: WRITE (I02,80003) IVTNUM 01580098
162: IF (ICZERO) 49090, 9101, 49090 01590098
163: 49090 IF (IVCOMP - 32176) 29090,19090,29090 01600098
164: 19090 IVPASS = IVPASS + 1 01610098
165: WRITE (I02,80001) IVTNUM 01620098
166: GO TO 9101 01630098
167: 29090 IVFAIL = IVFAIL + 1 01640098
168: IVCORR = 32176 01650098
169: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01660098
170: C 01670098
171: C TEST 910 THROUGH TEST 913 CONTAIN INTRINSIC FUNCTION TESTS FOR 01680098
172: C TRUNCATION WHERE ARGUMENT IS REAL AND FUNCTION IS INTEGER 01690098
173: C 01700098
174: 9101 CONTINUE 01710098
175: IVTNUM = 910 01720098
176: C 01730098
177: C **** TEST 910 **** 01740098
178: C 01750098
179: IF (ICZERO) 39100, 9100, 39100 01760098
180: 9100 CONTINUE 01770098
181: IVCOMP = INT (38.2) 01780098
182: GO TO 49100 01790098
183: 39100 IVDELE = IVDELE + 1 01800098
184: WRITE (I02,80003) IVTNUM 01810098
185: IF (ICZERO) 49100, 9111, 49100 01820098
186: 49100 IF (IVCOMP - 38) 29100,19100,29100 01830098
187: 19100 IVPASS = IVPASS + 1 01840098
188: WRITE (I02,80001) IVTNUM 01850098
189: GO TO 9111 01860098
190: 29100 IVFAIL = IVFAIL + 1 01870098
191: IVCORR = 38 01880098
192: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01890098
193: 9111 CONTINUE 01900098
194: IVTNUM = 911 01910098
195: C 01920098
196: C **** TEST 911 **** 01930098
197: C 01940098
198: IF (ICZERO) 39110, 9110, 39110 01950098
199: 9110 CONTINUE 01960098
200: RVON01 = -445.95 01970098
201: IVCOMP = INT (RVON01) 01980098
202: GO TO 49110 01990098
203: 39110 IVDELE = IVDELE + 1 02000098
204: WRITE (I02,80003) IVTNUM 02010098
205: IF (ICZERO) 49110, 9121, 49110 02020098
206: 49110 IF (IVCOMP + 445) 29110,19110,29110 02030098
207: 19110 IVPASS = IVPASS + 1 02040098
208: WRITE (I02,80001) IVTNUM 02050098
209: GO TO 9121 02060098
210: 29110 IVFAIL = IVFAIL + 1 02070098
211: IVCORR = -445 02080098
212: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02090098
213: 9121 CONTINUE 02100098
214: IVTNUM = 912 02110098
215: C 02120098
216: C **** TEST 912 **** 02130098
217: C 02140098
218: IF (ICZERO) 39120, 9120, 39120 02150098
219: 9120 CONTINUE 02160098
220: RVON01 = 466.01 02170098
221: IVCOMP = INT (RVON01) 02180098
222: GO TO 49120 02190098
223: 39120 IVDELE = IVDELE + 1 02200098
224: WRITE (I02,80003) IVTNUM 02210098
225: IF (ICZERO) 49120, 9131, 49120 02220098
226: 49120 IF (IVCOMP - 466) 29120,19120,29120 02230098
227: 19120 IVPASS = IVPASS + 1 02240098
228: WRITE (I02,80001) IVTNUM 02250098
229: GO TO 9131 02260098
230: 29120 IVFAIL = IVFAIL + 1 02270098
231: IVCORR = 466 02280098
232: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02290098
233: 9131 CONTINUE 02300098
234: IVTNUM = 913 02310098
235: C 02320098
236: C **** TEST 913 **** 02330098
237: C 02340098
238: IF (ICZERO) 39130, 9130, 39130 02350098
239: 9130 CONTINUE 02360098
240: RVON01 = 382E-1 02370098
241: IVCOMP = INT (RVON01) 02380098
242: GO TO 49130 02390098
243: 39130 IVDELE = IVDELE + 1 02400098
244: WRITE (I02,80003) IVTNUM 02410098
245: IF (ICZERO) 49130, 9141, 49130 02420098
246: 49130 IF (IVCOMP - 38) 29130,19130,29130 02430098
247: 19130 IVPASS = IVPASS + 1 02440098
248: WRITE (I02,80001) IVTNUM 02450098
249: GO TO 9141 02460098
250: 29130 IVFAIL = IVFAIL + 1 02470098
251: IVCORR = 38 02480098
252: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02490098
253: C 02500098
254: C TEST 914 THROUGH TEST 917 CONTAIN INTRINSIC FUNCTION TESTS FOR 02510098
255: C REMAINDERING WHERE ARGUMENTS AND FUNCTION ARE INTEGERS 02520098
256: C 02530098
257: 9141 CONTINUE 02540098
258: IVTNUM = 914 02550098
259: C 02560098
260: C **** TEST 914 **** 02570098
261: C 02580098
262: IF (ICZERO) 39140, 9140, 39140 02590098
263: 9140 CONTINUE 02600098
264: IVCOMP = MOD (42,19) 02610098
265: GO TO 49140 02620098
266: 39140 IVDELE = IVDELE + 1 02630098
267: WRITE (I02,80003) IVTNUM 02640098
268: IF (ICZERO) 49140, 9151, 49140 02650098
269: 49140 IF (IVCOMP - 4) 29140,19140,29140 02660098
270: 19140 IVPASS = IVPASS + 1 02670098
271: WRITE (I02,80001) IVTNUM 02680098
272: GO TO 9151 02690098
273: 29140 IVFAIL = IVFAIL + 1 02700098
274: IVCORR = 4 02710098
275: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02720098
276: 9151 CONTINUE 02730098
277: IVTNUM = 915 02740098
278: C 02750098
279: C **** TEST 915 **** 02760098
280: C 02770098
281: IF (ICZERO) 39150, 9150, 39150 02780098
282: 9150 CONTINUE 02790098
283: IVON01 = 6667 02800098
284: IVON02 = 2 02810098
285: IVCOMP = MOD (IVON01,IVON02) 02820098
286: GO TO 49150 02830098
287: 39150 IVDELE = IVDELE + 1 02840098
288: WRITE (I02,80003) IVTNUM 02850098
289: IF (ICZERO) 49150, 9161, 49150 02860098
290: 49150 IF (IVCOMP - 1) 29150,19150,29150 02870098
291: 19150 IVPASS = IVPASS + 1 02880098
292: WRITE (I02,80001) IVTNUM 02890098
293: GO TO 9161 02900098
294: 29150 IVFAIL = IVFAIL + 1 02910098
295: IVCORR = 1 02920098
296: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02930098
297: 9161 CONTINUE 02940098
298: IVTNUM = 916 02950098
299: C 02960098
300: C **** TEST 916 **** 02970098
301: C 02980098
302: IF (ICZERO) 39160, 9160, 39160 02990098
303: 9160 CONTINUE 03000098
304: IVON01 = 225 03010098
305: IVON02 = 50 03020098
306: IVCOMP = MOD (IVON01,IVON02) 03030098
307: GO TO 49160 03040098
308: 39160 IVDELE = IVDELE + 1 03050098
309: WRITE (I02,80003) IVTNUM 03060098
310: IF (ICZERO) 49160, 9171, 49160 03070098
311: 49160 IF (IVCOMP - 25) 29160,19160,29160 03080098
312: 19160 IVPASS = IVPASS + 1 03090098
313: WRITE (I02,80001) IVTNUM 03100098
314: GO TO 9171 03110098
315: 29160 IVFAIL = IVFAIL + 1 03120098
316: IVCORR = 25 03130098
317: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03140098
318: 9171 CONTINUE 03150098
319: IVTNUM = 917 03160098
320: C 03170098
321: C **** TEST 917 **** 03180098
322: C 03190098
323: IF (ICZERO) 39170, 9170, 39170 03200098
324: 9170 CONTINUE 03210098
325: IVON01 = -39 03220098
326: IVON02 = 500 03230098
327: IVCOMP = MOD (IVON01,IVON02) 03240098
328: GO TO 49170 03250098
329: 39170 IVDELE = IVDELE + 1 03260098
330: WRITE (I02,80003) IVTNUM 03270098
331: IF (ICZERO) 49170, 9181, 49170 03280098
332: 49170 IF (IVCOMP + 39) 29170,19170,29170 03290098
333: 19170 IVPASS = IVPASS + 1 03300098
334: WRITE (I02,80001) IVTNUM 03310098
335: GO TO 9181 03320098
336: 29170 IVFAIL = IVFAIL + 1 03330098
337: IVCORR = -39 03340098
338: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03350098
339: C 03360098
340: C TEST 918 AND 919 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 03370098
341: C LARGEST VALUE WHERE ARGUMENTS AND FUNCTION ARE INTEGER 03380098
342: C 03390098
343: 9181 CONTINUE 03400098
344: IVTNUM = 918 03410098
345: C 03420098
346: C **** TEST 918 **** 03430098
347: C 03440098
348: IF (ICZERO) 39180, 9180, 39180 03450098
349: 9180 CONTINUE 03460098
350: IVON01 = 317 03470098
351: IVON02 = -99 03480098
352: IVON03 = 1 03490098
353: IVCOMP = MAX0 (263,IVON01,IVON02,IVON03) 03500098
354: GO TO 49180 03510098
355: 39180 IVDELE = IVDELE + 1 03520098
356: WRITE (I02,80003) IVTNUM 03530098
357: IF (ICZERO) 49180, 9191, 49180 03540098
358: 49180 IF (IVCOMP - 317) 29180,19180,29180 03550098
359: 19180 IVPASS = IVPASS + 1 03560098
360: WRITE (I02,80001) IVTNUM 03570098
361: GO TO 9191 03580098
362: 29180 IVFAIL = IVFAIL + 1 03590098
363: IVCORR = 317 03600098
364: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03610098
365: 9191 CONTINUE 03620098
366: IVTNUM = 919 03630098
367: C 03640098
368: C **** TEST 919 **** 03650098
369: C 03660098
370: IF (ICZERO) 39190, 9190, 39190 03670098
371: 9190 CONTINUE 03680098
372: IVON01 = 2572 03690098
373: IVON02 = 2570 03700098
374: IVCOMP = MAX0 (IVON01,IVON02) 03710098
375: GO TO 49190 03720098
376: 39190 IVDELE = IVDELE + 1 03730098
377: WRITE (I02,80003) IVTNUM 03740098
378: IF (ICZERO) 49190, 9201, 49190 03750098
379: 49190 IF (IVCOMP - 2572) 29190,19190,29190 03760098
380: 19190 IVPASS = IVPASS + 1 03770098
381: WRITE (I02,80001) IVTNUM 03780098
382: GO TO 9201 03790098
383: 29190 IVFAIL = IVFAIL + 1 03800098
384: IVCORR = 2572 03810098
385: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03820098
386: C 03830098
387: C TEST 920 AND 921 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 03840098
388: C LARGEST VALUE WHERE ARGUMENTS ARE REAL AND FUNCTION IS INTEGER 03850098
389: C 03860098
390: 9201 CONTINUE 03870098
391: IVTNUM = 920 03880098
392: C 03890098
393: C **** TEST 920 **** 03900098
394: C 03910098
395: IF (ICZERO) 39200, 9200, 39200 03920098
396: 9200 CONTINUE 03930098
397: RVON01 = .326E+2 03940098
398: RVON02 = 22.075 03950098
399: RVON03 = 76E-1 03960098
400: IVCOMP = MAX1 (RVON01,RVON02,RVON03) 03970098
401: GO TO 49200 03980098
402: 39200 IVDELE = IVDELE + 1 03990098
403: WRITE (I02,80003) IVTNUM 04000098
404: IF (ICZERO) 49200, 9211, 49200 04010098
405: 49200 IF (IVCOMP - 32) 29200,19200,29200 04020098
406: 19200 IVPASS = IVPASS + 1 04030098
407: WRITE (I02,80001) IVTNUM 04040098
408: GO TO 9211 04050098
409: 29200 IVFAIL = IVFAIL + 1 04060098
410: IVCORR = 32 04070098
411: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04080098
412: 9211 CONTINUE 04090098
413: IVTNUM = 921 04100098
414: C 04110098
415: C **** TEST 921 **** 04120098
416: C 04130098
417: IF (ICZERO) 39210, 9210, 39210 04140098
418: 9210 CONTINUE 04150098
419: RVON01 = -6.3E2 04160098
420: RVON02 = -21.0 04170098
421: IVCOMP = MAX1 (-463.3,RVON01,RVON02) 04180098
422: GO TO 49210 04190098
423: 39210 IVDELE = IVDELE + 1 04200098
424: WRITE (I02,80003) IVTNUM 04210098
425: IF (ICZERO) 49210, 9221, 49210 04220098
426: 49210 IF (IVCOMP + 21) 29210,19210,29210 04230098
427: 19210 IVPASS = IVPASS + 1 04240098
428: WRITE (I02,80001) IVTNUM 04250098
429: GO TO 9221 04260098
430: 29210 IVFAIL = IVFAIL + 1 04270098
431: IVCORR = -21 04280098
432: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04290098
433: C 04300098
434: C TEST 922 AND 923 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04310098
435: C SMALLEST VALUE WHERE ARGUMENTS AND FUNCTION ARE INTEGER 04320098
436: C 04330098
437: 9221 CONTINUE 04340098
438: IVTNUM = 922 04350098
439: C 04360098
440: C **** TEST 922 **** 04370098
441: C 04380098
442: IF (ICZERO) 39220, 9220, 39220 04390098
443: 9220 CONTINUE 04400098
444: IVON01 = -75 04410098
445: IVON02 = -243 04420098
446: IVCOMP = MIN0 (IVON01,IVON02) 04430098
447: GO TO 49220 04440098
448: 39220 IVDELE = IVDELE + 1 04450098
449: WRITE (I02,80003) IVTNUM 04460098
450: IF (ICZERO) 49220, 9231, 49220 04470098
451: 49220 IF (IVCOMP + 243) 29220,19220,29220 04480098
452: 19220 IVPASS = IVPASS + 1 04490098
453: WRITE (I02,80001) IVTNUM 04500098
454: GO TO 9231 04510098
455: 29220 IVFAIL = IVFAIL + 1 04520098
456: IVCORR = -243 04530098
457: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04540098
458: 9231 CONTINUE 04550098
459: IVTNUM = 923 04560098
460: C 04570098
461: C **** TEST 923 **** 04580098
462: C 04590098
463: IF (ICZERO) 39230, 9230, 39230 04600098
464: 9230 CONTINUE 04610098
465: IVON01 = -11 04620098
466: IVON02 = 11 04630098
467: IVCOMP = MIN0 (0,IVON01,IVON02) 04640098
468: GO TO 49230 04650098
469: 39230 IVDELE = IVDELE + 1 04660098
470: WRITE (I02,80003) IVTNUM 04670098
471: IF (ICZERO) 49230, 9241, 49230 04680098
472: 49230 IF (IVCOMP + 11) 29230,19230,29230 04690098
473: 19230 IVPASS = IVPASS + 1 04700098
474: WRITE (I02,80001) IVTNUM 04710098
475: GO TO 9241 04720098
476: 29230 IVFAIL = IVFAIL + 1 04730098
477: IVCORR = -11 04740098
478: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04750098
479: C 04760098
480: C TEST 924 AND 925 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04770098
481: C SMALLEST VALUE WHERE ARGUMENTS ARE REAL AND FUNCTION IS INTEGER 04780098
482: C 04790098
483: 9241 CONTINUE 04800098
484: IVTNUM = 924 04810098
485: C 04820098
486: C **** TEST 924 **** 04830098
487: C 04840098
488: IF (ICZERO) 39240, 9240, 39240 04850098
489: 9240 CONTINUE 04860098
490: RVON01 = 1.1111 04870098
491: RVON02 = 22.222 04880098
492: RVON03 = 333.33 04890098
493: IVCOMP = MIN1 (RVON01,RVON02,RVON03) 04900098
494: GO TO 49240 04910098
495: 39240 IVDELE = IVDELE + 1 04920098
496: WRITE (I02,80003) IVTNUM 04930098
497: IF (ICZERO) 49240, 9251, 49240 04940098
498: 49240 IF (IVCOMP - 1) 29240,19240,29240 04950098
499: 19240 IVPASS = IVPASS + 1 04960098
500: WRITE (I02,80001) IVTNUM 04970098
501: GO TO 9251 04980098
502: 29240 IVFAIL = IVFAIL + 1 04990098
503: IVCORR = 1 05000098
504: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05010098
505: 9251 CONTINUE 05020098
506: IVTNUM = 925 05030098
507: C 05040098
508: C **** TEST 925 **** 05050098
509: C 05060098
510: IF (ICZERO) 39250, 9250, 39250 05070098
511: 9250 CONTINUE 05080098
512: RVON01 = 28.8 05090098
513: RVON02 = 2.88E1 05100098
514: RVON03 = 288E-1 05110098
515: RVON04 = 35.0 05120098
516: IVCOMP = MIN1 (RVON01,RVON02,RVON03,RVON04) 05130098
517: GO TO 49250 05140098
518: 39250 IVDELE = IVDELE + 1 05150098
519: WRITE (I02,80003) IVTNUM 05160098
520: IF (ICZERO) 49250, 9261, 49250 05170098
521: 49250 IF (IVCOMP - 28) 29250,19250,29250 05180098
522: 19250 IVPASS = IVPASS + 1 05190098
523: WRITE (I02,80001) IVTNUM 05200098
524: GO TO 9261 05210098
525: 29250 IVFAIL = IVFAIL + 1 05220098
526: IVCORR = 28 05230098
527: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05240098
528: C 05250098
529: C TEST 926 THROUGH TEST 929 CONTAIN THE INTRINSIC FUNCTION FIX 05260098
530: C WHICH CONVERTS REAL ARGUMENTS TO INTEGER FUNCTION RESULTS 05270098
531: C 05280098
532: 9261 CONTINUE 05290098
533: IVTNUM = 926 05300098
534: C 05310098
535: C **** TEST 926 **** 05320098
536: C 05330098
537: IF (ICZERO) 39260, 9260, 39260 05340098
538: 9260 CONTINUE 05350098
539: IVCOMP = IFIX (-6.06) 05360098
540: GO TO 49260 05370098
541: 39260 IVDELE = IVDELE + 1 05380098
542: WRITE (I02,80003) IVTNUM 05390098
543: IF (ICZERO) 49260, 9271, 49260 05400098
544: 49260 IF (IVCOMP + 6) 29260,19260,29260 05410098
545: 19260 IVPASS = IVPASS + 1 05420098
546: WRITE (I02,80001) IVTNUM 05430098
547: GO TO 9271 05440098
548: 29260 IVFAIL = IVFAIL + 1 05450098
549: IVCORR = -6 05460098
550: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05470098
551: 9271 CONTINUE 05480098
552: IVTNUM = 927 05490098
553: C 05500098
554: C **** TEST 927 **** 05510098
555: C 05520098
556: IF (ICZERO) 39270, 9270, 39270 05530098
557: 9270 CONTINUE 05540098
558: RVON01 = 71.01 05550098
559: IVCOMP = IFIX (RVON01) 05560098
560: GO TO 49270 05570098
561: 39270 IVDELE = IVDELE + 1 05580098
562: WRITE (I02,80003) IVTNUM 05590098
563: IF (ICZERO) 49270, 9281, 49270 05600098
564: 49270 IF (IVCOMP - 71) 29270,19270,29270 05610098
565: 19270 IVPASS = IVPASS + 1 05620098
566: WRITE (I02,80001) IVTNUM 05630098
567: GO TO 9281 05640098
568: 29270 IVFAIL = IVFAIL + 1 05650098
569: IVCORR = 71 05660098
570: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05670098
571: 9281 CONTINUE 05680098
572: IVTNUM = 928 05690098
573: C 05700098
574: C **** TEST 928 **** 05710098
575: C 05720098
576: IF (ICZERO) 39280, 9280, 39280 05730098
577: 9280 CONTINUE 05740098
578: RVON01 = 3.211E2 05750098
579: IVCOMP = IFIX (RVON01) 05760098
580: GO TO 49280 05770098
581: 39280 IVDELE = IVDELE + 1 05780098
582: WRITE (I02,80003) IVTNUM 05790098
583: IF (ICZERO) 49280, 9291, 49280 05800098
584: 49280 IF (IVCOMP - 321) 29280,19280,29280 05810098
585: 19280 IVPASS = IVPASS + 1 05820098
586: WRITE (I02,80001) IVTNUM 05830098
587: GO TO 9291 05840098
588: 29280 IVFAIL = IVFAIL + 1 05850098
589: IVCORR = 321 05860098
590: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05870098
591: 9291 CONTINUE 05880098
592: IVTNUM = 929 05890098
593: C 05900098
594: C **** TEST 929 **** 05910098
595: C 05920098
596: IF (ICZERO) 39290, 9290, 39290 05930098
597: 9290 CONTINUE 05940098
598: RVON01 = 777E-1 05950098
599: IVCOMP = IFIX (RVON01) 05960098
600: GO TO 49290 05970098
601: 39290 IVDELE = IVDELE + 1 05980098
602: WRITE (I02,80003) IVTNUM 05990098
603: IF (ICZERO) 49290, 9301, 49290 06000098
604: 49290 IF (IVCOMP - 77) 29290,19290,29290 06010098
605: 19290 IVPASS = IVPASS + 1 06020098
606: WRITE (I02,80001) IVTNUM 06030098
607: GO TO 9301 06040098
608: 29290 IVFAIL = IVFAIL + 1 06050098
609: IVCORR = 77 06060098
610: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06070098
611: C 06080098
612: C TEST 930 THROUGH TEST 932 CONTAIN INTRINSIC FUNCTION TESTS FOR 06090098
613: C TRANSFER OF SIGN WHERE ARGUMENTS AND FUNCTION ARE INTEGER 06100098
614: C 06110098
615: 9301 CONTINUE 06120098
616: IVTNUM = 930 06130098
617: C 06140098
618: C **** TEST 930 **** 06150098
619: C 06160098
620: IF (ICZERO) 39300, 9300, 39300 06170098
621: 9300 CONTINUE 06180098
622: IVON01 = 643 06190098
623: IVCOMP = ISIGN (IVON01,-1) 06200098
624: GO TO 49300 06210098
625: 39300 IVDELE = IVDELE + 1 06220098
626: WRITE (I02,80003) IVTNUM 06230098
627: IF (ICZERO) 49300, 9311, 49300 06240098
628: 49300 IF (IVCOMP + 643) 29300,19300,29300 06250098
629: 19300 IVPASS = IVPASS + 1 06260098
630: WRITE (I02,80001) IVTNUM 06270098
631: GO TO 9311 06280098
632: 29300 IVFAIL = IVFAIL + 1 06290098
633: IVCORR = -643 06300098
634: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06310098
635: 9311 CONTINUE 06320098
636: IVTNUM = 931 06330098
637: C 06340098
638: C **** TEST 931 **** 06350098
639: C 06360098
640: IF (ICZERO) 39310, 9310, 39310 06370098
641: 9310 CONTINUE 06380098
642: IVON01 = -22 06390098
643: IVON02 = 723 06400098
644: IVCOMP = ISIGN (IVON01,IVON02) 06410098
645: GO TO 49310 06420098
646: 39310 IVDELE = IVDELE + 1 06430098
647: WRITE (I02,80003) IVTNUM 06440098
648: IF (ICZERO) 49310, 9321, 49310 06450098
649: 49310 IF (IVCOMP - 22) 29310,19310,29310 06460098
650: 19310 IVPASS = IVPASS + 1 06470098
651: WRITE (I02,80001) IVTNUM 06480098
652: GO TO 9321 06490098
653: 29310 IVFAIL = IVFAIL + 1 06500098
654: IVCORR = 22 06510098
655: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06520098
656: 9321 CONTINUE 06530098
657: IVTNUM = 932 06540098
658: C 06550098
659: C **** TEST 932 **** 06560098
660: C 06570098
661: IF (ICZERO) 39320, 9320, 39320 06580098
662: 9320 CONTINUE 06590098
663: IVON01 = 3532 06600098
664: IVON02 = 1 06610098
665: IVCOMP = ISIGN (IVON01,IVON02) 06620098
666: GO TO 49320 06630098
667: 39320 IVDELE = IVDELE + 1 06640098
668: WRITE (I02,80003) IVTNUM 06650098
669: IF (ICZERO) 49320, 9331, 49320 06660098
670: 49320 IF (IVCOMP - 3532) 29320,19320,29320 06670098
671: 19320 IVPASS = IVPASS + 1 06680098
672: WRITE (I02,80001) IVTNUM 06690098
673: GO TO 9331 06700098
674: 29320 IVFAIL = IVFAIL + 1 06710098
675: IVCORR = 3532 06720098
676: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06730098
677: C 06740098
678: C TEST 933 THROUGH TEST 936 CONTAIN INTRINSIC FUNCTION TESTS FOR 06750098
679: C POSITIVE DIFFERENCE WHERE ARGUMENTS AND FUNCTION ARE INTEGERS 06760098
680: C 06770098
681: 9331 CONTINUE 06780098
682: IVTNUM = 933 06790098
683: C 06800098
684: C **** TEST 933 **** 06810098
685: C 06820098
686: IF (ICZERO) 39330, 9330, 39330 06830098
687: 9330 CONTINUE 06840098
688: IVON01 = 222 06850098
689: IVCOMP = IDIM (IVON01,1) 06860098
690: GO TO 49330 06870098
691: 39330 IVDELE = IVDELE + 1 06880098
692: WRITE (I02,80003) IVTNUM 06890098
693: IF (ICZERO) 49330, 9341, 49330 06900098
694: 49330 IF (IVCOMP - 221) 29330,19330,29330 06910098
695: 19330 IVPASS = IVPASS + 1 06920098
696: WRITE (I02,80001) IVTNUM 06930098
697: GO TO 9341 06940098
698: 29330 IVFAIL = IVFAIL + 1 06950098
699: IVCORR = 221 06960098
700: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06970098
701: 9341 CONTINUE 06980098
702: IVTNUM = 934 06990098
703: C 07000098
704: C **** TEST 934 **** 07010098
705: C 07020098
706: IF (ICZERO) 39340, 9340, 39340 07030098
707: 9340 CONTINUE 07040098
708: IVON01 = 45 07050098
709: IVON02 = 41 07060098
710: IVCOMP = IDIM (IVON01,IVON02) 07070098
711: GO TO 49340 07080098
712: 39340 IVDELE = IVDELE + 1 07090098
713: WRITE (I02,80003) IVTNUM 07100098
714: IF (ICZERO) 49340, 9351, 49340 07110098
715: 49340 IF (IVCOMP - 4) 29340,19340,29340 07120098
716: 19340 IVPASS = IVPASS + 1 07130098
717: WRITE (I02,80001) IVTNUM 07140098
718: GO TO 9351 07150098
719: 29340 IVFAIL = IVFAIL + 1 07160098
720: IVCORR = 4 07170098
721: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07180098
722: 9351 CONTINUE 07190098
723: IVTNUM = 935 07200098
724: C 07210098
725: C **** TEST 935 **** 07220098
726: C 07230098
727: IF (ICZERO) 39350, 9350, 39350 07240098
728: 9350 CONTINUE 07250098
729: IVON01 = 2 07260098
730: IVON02 = 10 07270098
731: IVCOMP = IDIM (IVON01,IVON02) 07280098
732: GO TO 49350 07290098
733: 39350 IVDELE = IVDELE + 1 07300098
734: WRITE (I02,80003) IVTNUM 07310098
735: IF (ICZERO) 49350, 9361, 49350 07320098
736: 49350 IF (IVCOMP) 29350,19350,29350 07330098
737: 19350 IVPASS = IVPASS + 1 07340098
738: WRITE (I02,80001) IVTNUM 07350098
739: GO TO 9361 07360098
740: 29350 IVFAIL = IVFAIL + 1 07370098
741: IVCORR = 0 07380098
742: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07390098
743: 9361 CONTINUE 07400098
744: IVTNUM = 936 07410098
745: C 07420098
746: C **** TEST 936 **** 07430098
747: C 07440098
748: IF (ICZERO) 39360, 9360, 39360 07450098
749: 9360 CONTINUE 07460098
750: IVON01 = 165 07470098
751: IVON02 = -2 07480098
752: IVCOMP = IDIM (IVON01,IVON02) 07490098
753: GO TO 49360 07500098
754: 39360 IVDELE = IVDELE + 1 07510098
755: WRITE (I02,80003) IVTNUM 07520098
756: IF (ICZERO) 49360, 9371, 49360 07530098
757: 49360 IF (IVCOMP - 167) 29360,19360,29360 07540098
758: 19360 IVPASS = IVPASS + 1 07550098
759: WRITE (I02,80001) IVTNUM 07560098
760: GO TO 9371 07570098
761: 29360 IVFAIL = IVFAIL + 1 07580098
762: IVCORR = 167 07590098
763: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07600098
764: C 07610098
765: C TESTS 937 AND 938 CONTAIN EXPRESSIONS CONTAINING MORE THAN ONE 07620098
766: C INTRINSIC FUNCTION - THE FUNCTIONS ARE INTEGER AND THE ARGUMENTS 07630098
767: C ARE REAL AND INTEGER 07640098
768: C 07650098
769: 9371 CONTINUE 07660098
770: IVTNUM = 937 07670098
771: C 07680098
772: C **** TEST 937 **** 07690098
773: C 07700098
774: IF (ICZERO) 39370, 9370, 39370 07710098
775: 9370 CONTINUE 07720098
776: RVON01 = 33.3 07730098
777: IVON01 = -12 07740098
778: IVCOMP = INT (RVON01) + IABS (IVON01) 07750098
779: GO TO 49370 07760098
780: 39370 IVDELE = IVDELE + 1 07770098
781: WRITE (I02,80003) IVTNUM 07780098
782: IF (ICZERO) 49370, 9381, 49370 07790098
783: 49370 IF (IVCOMP - 45) 29370,19370,29370 07800098
784: 19370 IVPASS = IVPASS + 1 07810098
785: WRITE (I02,80001) IVTNUM 07820098
786: GO TO 9381 07830098
787: 29370 IVFAIL = IVFAIL + 1 07840098
788: IVCORR = 45 07850098
789: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07860098
790: 9381 CONTINUE 07870098
791: IVTNUM = 938 07880098
792: C 07890098
793: C **** TEST 938 **** 07900098
794: C 07910098
795: IF (ICZERO) 39380, 9380, 39380 07920098
796: 9380 CONTINUE 07930098
797: IVON01 = 76 07940098
798: IVON02 = 21 07950098
799: IVON03 = 30 07960098
800: IVCOMP = MAX0 (IVON01,IVON02,IVON03) - MIN0 (IVON01,IVON02,IVON03)07970098
801: GO TO 49380 07980098
802: 39380 IVDELE = IVDELE + 1 07990098
803: WRITE (I02,80003) IVTNUM 08000098
804: IF (ICZERO) 49380, 9391, 49380 08010098
805: 49380 IF (IVCOMP - 55) 29380,19380,29380 08020098
806: 19380 IVPASS = IVPASS + 1 08030098
807: WRITE (I02,80001) IVTNUM 08040098
808: GO TO 9391 08050098
809: 29380 IVFAIL = IVFAIL + 1 08060098
810: IVCORR = 55 08070098
811: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 08080098
812: 9391 CONTINUE 08090098
813: C 08100098
814: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08110098
815: 99999 CONTINUE 08120098
816: WRITE (I02,90002) 08130098
817: WRITE (I02,90006) 08140098
818: WRITE (I02,90002) 08150098
819: WRITE (I02,90002) 08160098
820: WRITE (I02,90007) 08170098
821: WRITE (I02,90002) 08180098
822: WRITE (I02,90008) IVFAIL 08190098
823: WRITE (I02,90009) IVPASS 08200098
824: WRITE (I02,90010) IVDELE 08210098
825: C 08220098
826: C 08230098
827: C TERMINATE ROUTINE EXECUTION 08240098
828: STOP 08250098
829: C 08260098
830: C FORMAT STATEMENTS FOR PAGE HEADERS 08270098
831: 90000 FORMAT (1H1) 08280098
832: 90002 FORMAT (1H ) 08290098
833: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 08300098
834: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 08310098
835: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 08320098
836: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 08330098
837: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 08340098
838: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 08350098
839: C 08360098
840: C FORMAT STATEMENTS FOR RUN SUMMARIES 08370098
841: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 08380098
842: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 08390098
843: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 08400098
844: C 08410098
845: C FORMAT STATEMENTS FOR TEST RESULTS 08420098
846: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 08430098
847: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 08440098
848: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 08450098
849: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 08460098
850: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 08470098
851: C 08480098
852: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM098) 08490098
853: END 08500098
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.