|
|
1.1 root 1: C COMMENT SECTION 00010060
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 00020060
6: C FM060 00030060
7: C 00040060
8: C THIS ROUTINE CONTAINS BASIC ARITHMETIC IF STATEMENT TESTS FOR 00050060
9: C THE FORMAT 00060060
10: C 00070060
11: C IF (E) K1,K2,K3 00080060
12: C 00090060
13: C WHERE E IS A SIMPLE REAL EXPRESSION OF THE FORM 00100060
14: C 00110060
15: C REAL VARIABLE 00120060
16: C REAL VARIABLE - REAL CONSTANT 00130060
17: C REAL VARIABLE + REAL CONSTANT 00140060
18: C 00150060
19: C AND K1, K2 AND K3 ARE STATEMENT LABELS. 00160060
20: C 00170060
21: C THIS ROUTINE ALSO TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF 00180060
22: C THE FORM 00190060
23: C REAL VARIABLE = REAL CONSTANT 00200060
24: C REAL VARIABLE = REAL VARIABLE 00210060
25: C REAL VARIABLE = -REAL VARIABLE 00220060
26: C 00230060
27: C THE REAL CONSTANTS AND REAL VARIABLES CONTAIN BOTH POSITIVE AND 00240060
28: C NEGATIVE VALUES. 00250060
29: C 00260060
30: C A REAL DATUM IS A PROCESSOR APPROXIMATION TO THE VALUE OF A 00270060
31: C REAL NUMBER. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES. 00280060
32: C 00290060
33: C A BASIC REAL CONSTANT IS WRITTEN AS AN INTEGER PART, A DECIMAL00300060
34: C POINT, AND A DECIMAL FRACTION PART IN THAT ORDER. BOTH THE 00310060
35: C INTEGER PART AND THE DECIMAL PART ARE STRINGS OF DIGITS; EITHER 00320060
36: C ONE OF THESE STRINGS MAY BE EMPTY BUT NOT BOTH. THE CONSTANT IS 00330060
37: C AN APPROXIMATION TO THE DIGIT STRING INTERPRETED AS A DECIMAL 00340060
38: C NUMERAL. 00350060
39: C 00360060
40: C A DECIMAL EXPONENT IS WRITTEN AS THE LETTER E, FOLLOWED BY AN 00370060
41: C OPTIONALLY SIGNED INTEGER CONSTANT. 00380060
42: C 00390060
43: C A REAL CONSTANT IS INDICATED BY WRITING A BASIC REAL CONSTANT,00400060
44: C A BASIC REAL CONSTANT FOLLOWED BY A DECIMAL EXPONENT, OR AN 00410060
45: C INTEGER CONSTANT FOLLOWED BY A DECIMAL EXPONENT. 00420060
46: C 00430060
47: C REFERENCES 00440060
48: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00450060
49: C X3.9-1978 00460060
50: C 00470060
51: C SECTION 4.4, REAL TYPE 00480060
52: C SECTION 4.4.1, REAL CONSTANT 00490060
53: C SECTION 6.1, ARITHMETIC EXPRESSIONS 00500060
54: C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00510060
55: C SECTION 11.4, ARITHMETIC IF STATEMENT 00520060
56: C 00530060
57: C ********************************************************** 00540060
58: C 00550060
59: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00560060
60: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00570060
61: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00580060
62: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00590060
63: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00600060
64: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00610060
65: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00620060
66: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00630060
67: C OF EXECUTING THESE TESTS. 00640060
68: C 00650060
69: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00660060
70: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00670060
71: C 00680060
72: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00690060
73: C 00700060
74: C DEPARTMENT OF THE NAVY 00710060
75: C FEDERAL COBOL COMPILER TESTING SERVICE 00720060
76: C WASHINGTON, D.C. 20376 00730060
77: C 00740060
78: C ********************************************************** 00750060
79: C 00760060
80: C 00770060
81: C 00780060
82: C INITIALIZATION SECTION 00790060
83: C 00800060
84: C INITIALIZE CONSTANTS 00810060
85: C ************** 00820060
86: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00830060
87: I01 = 5 00840060
88: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00850060
89: I02 = 6 00860060
90: C SYSTEM ENVIRONMENT SECTION 00870060
91: C 00880060
92: I01 = 5 00890060
93: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00900060
94: C (UNIT NUMBER FOR CARD READER). 00910060
95: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00920060
96: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00930060
97: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00940060
98: C 00950060
99: I02 = 6 00960060
100: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00970060
101: C (UNIT NUMBER FOR PRINTER). 00980060
102: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00990060
103: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01000060
104: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01010060
105: C 01020060
106: IVPASS=0 01030060
107: IVFAIL=0 01040060
108: IVDELE=0 01050060
109: ICZERO=0 01060060
110: C 01070060
111: C WRITE PAGE HEADERS 01080060
112: WRITE (I02,90000) 01090060
113: WRITE (I02,90001) 01100060
114: WRITE (I02,90002) 01110060
115: WRITE (I02, 90002) 01120060
116: WRITE (I02,90003) 01130060
117: WRITE (I02,90002) 01140060
118: WRITE (I02,90004) 01150060
119: WRITE (I02,90002) 01160060
120: WRITE (I02,90011) 01170060
121: WRITE (I02,90002) 01180060
122: WRITE (I02,90002) 01190060
123: WRITE (I02,90005) 01200060
124: WRITE (I02,90006) 01210060
125: WRITE (I02,90002) 01220060
126: C 01230060
127: C TEST SECTION 01240060
128: C 01250060
129: C ARITHMETIC IF STATEMENT 01260060
130: C 01270060
131: C TEST 1 THROUGH TEST 3 CONTAIN BASIC ARITHMETIC IF STATEMENT TESTS 01280060
132: C WITH A REAL VARIABLE AS ARITHMETIC EXPRESSION. 01290060
133: C 01300060
134: 11 CONTINUE 01310060
135: IVTNUM = 1 01320060
136: C 01330060
137: C **** TEST 1 **** 01340060
138: C TEST 001 - LESS THAN ZERO BRANCH EXPECTED 01350060
139: C 01360060
140: IF (ICZERO) 30010, 10, 30010 01370060
141: 10 CONTINUE 01380060
142: RVCOMP = 0.0 01390060
143: RVON01 = -1.0 01400060
144: IF (RVON01) 12,40010, 40010 01410060
145: 12 RVCOMP = RVON01 01420060
146: GO TO 40010 01430060
147: 30010 IVDELE = IVDELE + 1 01440060
148: WRITE (I02,80003) IVTNUM 01450060
149: IF (ICZERO) 40010, 21, 40010 01460060
150: 40010 IF (RVCOMP) 10010,20010,20010 01470060
151: 10010 IVPASS = IVPASS + 1 01480060
152: WRITE (I02,80001) IVTNUM 01490060
153: GO TO 21 01500060
154: 20010 IVFAIL = IVFAIL + 1 01510060
155: RVCORR = -1.0 01520060
156: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01530060
157: 21 CONTINUE 01540060
158: IVTNUM = 2 01550060
159: C 01560060
160: C **** TEST 2 **** 01570060
161: C TEST 002 - EQUAL TO ZERO BRANCH EXPECTED 01580060
162: C 01590060
163: IF (ICZERO) 30020, 20, 30020 01600060
164: 20 CONTINUE 01610060
165: RVCOMP = 1.0 01620060
166: RVON01 = 0.0 01630060
167: IF (RVON01) 40020,22,40020 01640060
168: 22 RVCOMP = RVON01 01650060
169: GO TO 40020 01660060
170: 30020 IVDELE = IVDELE + 1 01670060
171: WRITE (I02,80003) IVTNUM 01680060
172: IF (ICZERO) 40020, 31, 40020 01690060
173: 40020 IF (RVCOMP) 20020,10020,20020 01700060
174: 10020 IVPASS = IVPASS + 1 01710060
175: WRITE (I02,80001) IVTNUM 01720060
176: GO TO 31 01730060
177: 20020 IVFAIL = IVFAIL + 1 01740060
178: RVCORR = 0.0 01750060
179: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01760060
180: 31 CONTINUE 01770060
181: IVTNUM = 3 01780060
182: C 01790060
183: C **** TEST 3 **** 01800060
184: C TEST 003 - GREATER THAN ZERO BRANCH EXPECTED 01810060
185: C 01820060
186: IF (ICZERO) 30030, 30, 30030 01830060
187: 30 CONTINUE 01840060
188: RVCOMP = 0.0 01850060
189: RVON01 = 1.0 01860060
190: IF (RVON01) 40030,40030,32 01870060
191: 32 RVCOMP = RVON01 01880060
192: GO TO 40030 01890060
193: 30030 IVDELE = IVDELE + 1 01900060
194: WRITE (I02,80003) IVTNUM 01910060
195: IF (ICZERO) 40030, 41, 40030 01920060
196: 40030 IF (RVCOMP) 20030,20030,10030 01930060
197: 10030 IVPASS = IVPASS + 1 01940060
198: WRITE (I02,80001) IVTNUM 01950060
199: GO TO 41 01960060
200: 20030 IVFAIL = IVFAIL + 1 01970060
201: RVCORR = 1.0 01980060
202: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01990060
203: 41 CONTINUE 02000060
204: IVTNUM = 4 02010060
205: C 02020060
206: C **** TEST 4 **** 02030060
207: C TEST 004 - BASIC IF STATEMENTS TEST 02040060
208: C THESE IF STATEMENTS ARE USED IN REAL VARIABLE TEST 02050060
209: C VERIFICATION. THE ARITHMETIC EXPRESSIONS ARE OF THE FORM 02060060
210: C REAL VARIABLE - REAL CONSTANT 02070060
211: C 02080060
212: IF (ICZERO) 30040, 40, 30040 02090060
213: 40 CONTINUE 02100060
214: RVCOMP = 4.0 02110060
215: RVON01 = 1.0 02120060
216: IF (RVON01 - .99995) 40040,42,42 02130060
217: 42 IF (RVON01 - 1.0005) 43,43,40040 02140060
218: 43 RVCOMP = 0.0 02150060
219: GO TO 40040 02160060
220: 30040 IVDELE = IVDELE + 1 02170060
221: WRITE (I02,80003) IVTNUM 02180060
222: IF (ICZERO) 40040, 51, 40040 02190060
223: 40040 IF (RVCOMP) 20040,10040,20040 02200060
224: 10040 IVPASS = IVPASS + 1 02210060
225: WRITE (I02,80001) IVTNUM 02220060
226: GO TO 51 02230060
227: 20040 IVFAIL = IVFAIL + 1 02240060
228: RVCORR = 0.0 02250060
229: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02260060
230: 51 CONTINUE 02270060
231: IVTNUM = 5 02280060
232: C 02290060
233: C **** TEST 5 **** 02300060
234: C TEST 005 - BASIC IF STATEMENTS TEST 02310060
235: C THESE IF STATEMENTS ARE USED IN REAL VARIABLE TEST 02320060
236: C VERIFICATION. THE ARITHMETIC EXPRESSIONS ARE OF THE FORM 02330060
237: C REAL VARIABLE + REAL CONSTANT 02340060
238: C 02350060
239: IF (ICZERO) 30050, 50, 30050 02360060
240: 50 CONTINUE 02370060
241: RVCOMP = -1.0 02380060
242: RVON01 = -1.0 02390060
243: IF (RVON01 + 1.0005) 40050,52,52 02400060
244: 52 IF (RVON01 + .99995) 53,53,40050 02410060
245: 53 RVCOMP = 0.0 02420060
246: GO TO 40050 02430060
247: 30050 IVDELE = IVDELE + 1 02440060
248: WRITE (I02,80003) IVTNUM 02450060
249: IF (ICZERO) 40050, 61, 40050 02460060
250: 40050 IF (RVCOMP) 20050,10050,20050 02470060
251: 10050 IVPASS = IVPASS + 1 02480060
252: WRITE (I02,80001) IVTNUM 02490060
253: GO TO 61 02500060
254: 20050 IVFAIL = IVFAIL + 1 02510060
255: RVCORR = 0.0 02520060
256: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02530060
257: C 02540060
258: C ARITHMETIC ASSIGNMENT STATEMENT 02550060
259: C 02560060
260: C 02570060
261: C TEST 006 THROUGH TEST 025 CONTAIN ARITHMETIC ASSIGNMENT 02580060
262: C STATEMENTS OF THE FORM 02590060
263: C REAL VARIABLE = REAL CONSTANT 02600060
264: C 02610060
265: C THE THREE TYPES OF REAL CONSTANTS ARE TESTED WITH POSITIVE 02620060
266: C AND NEGATIVE VALUES FOR THE CONSTANTS, AND POSITIVE AND NEGATIVE 02630060
267: C EXPONENTS. 02640060
268: C 02650060
269: C TEST 006 THROUGH TEST 011 - CONSTANT IS BASIC REAL CONSTANT 02660060
270: C 02670060
271: 61 CONTINUE 02680060
272: IVTNUM = 6 02690060
273: C 02700060
274: C **** TEST 6 **** 02710060
275: C 02720060
276: IF (ICZERO) 30060, 60, 30060 02730060
277: 60 CONTINUE 02740060
278: RVCOMP = 2.0 02750060
279: GO TO 40060 02760060
280: 30060 IVDELE = IVDELE + 1 02770060
281: WRITE (I02,80003) IVTNUM 02780060
282: IF (ICZERO) 40060, 71, 40060 02790060
283: 40060 IF (RVCOMP - 1.9995) 20060,10060,40061 02800060
284: 40061 IF (RVCOMP - 2.0005) 10060,10060,20060 02810060
285: 10060 IVPASS = IVPASS + 1 02820060
286: WRITE (I02,80001) IVTNUM 02830060
287: GO TO 71 02840060
288: 20060 IVFAIL = IVFAIL + 1 02850060
289: RVCORR = 2.0 02860060
290: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02870060
291: 71 CONTINUE 02880060
292: IVTNUM = 7 02890060
293: C 02900060
294: C **** TEST 7 **** 02910060
295: C 02920060
296: IF (ICZERO) 30070, 70, 30070 02930060
297: 70 CONTINUE 02940060
298: RVCOMP = 44.5 02950060
299: GO TO 40070 02960060
300: 30070 IVDELE = IVDELE + 1 02970060
301: WRITE (I02,80003) IVTNUM 02980060
302: IF (ICZERO) 40070, 81, 40070 02990060
303: 40070 IF (RVCOMP - 44.495) 20070,10070,40071 03000060
304: 40071 IF (RVCOMP - 45.505) 10070,10070,20070 03010060
305: 10070 IVPASS = IVPASS + 1 03020060
306: WRITE (I02,80001) IVTNUM 03030060
307: GO TO 81 03040060
308: 20070 IVFAIL = IVFAIL + 1 03050060
309: RVCORR = 44.5 03060060
310: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03070060
311: 81 CONTINUE 03080060
312: IVTNUM = 8 03090060
313: C 03100060
314: C **** TEST 8 **** 03110060
315: C 03120060
316: IF (ICZERO) 30080, 80, 30080 03130060
317: 80 CONTINUE 03140060
318: RVCOMP = -2.0 03150060
319: GO TO 40080 03160060
320: 30080 IVDELE = IVDELE + 1 03170060
321: WRITE (I02,80003) IVTNUM 03180060
322: IF (ICZERO) 40080, 91, 40080 03190060
323: 40080 IF (RVCOMP + 2.0005) 20080,10080,40081 03200060
324: 40081 IF (RVCOMP + 1.9995) 10080,10080,20080 03210060
325: 10080 IVPASS = IVPASS + 1 03220060
326: WRITE (I02,80001) IVTNUM 03230060
327: GO TO 91 03240060
328: 20080 IVFAIL = IVFAIL + 1 03250060
329: RVCORR = -2.0 03260060
330: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03270060
331: 91 CONTINUE 03280060
332: IVTNUM = 9 03290060
333: C 03300060
334: C **** TEST 9 **** 03310060
335: C 03320060
336: IF (ICZERO) 30090, 90, 30090 03330060
337: 90 CONTINUE 03340060
338: RVCOMP = 65001. 03350060
339: GO TO 40090 03360060
340: 30090 IVDELE = IVDELE + 1 03370060
341: WRITE (I02,80003) IVTNUM 03380060
342: IF (ICZERO) 40090, 101, 40090 03390060
343: 40090 IF (RVCOMP - 64996.) 20090,10090,40091 03400060
344: 40091 IF (RVCOMP - 65006.) 10090,10090,20090 03410060
345: 10090 IVPASS = IVPASS + 1 03420060
346: WRITE (I02,80001) IVTNUM 03430060
347: GO TO 101 03440060
348: 20090 IVFAIL = IVFAIL + 1 03450060
349: RVCORR = 65001. 03460060
350: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03470060
351: 101 CONTINUE 03480060
352: IVTNUM = 10 03490060
353: C 03500060
354: C **** TEST 10 **** 03510060
355: C 03520060
356: IF (ICZERO) 30100, 100, 30100 03530060
357: 100 CONTINUE 03540060
358: RVCOMP = .65001 03550060
359: GO TO 40100 03560060
360: 30100 IVDELE = IVDELE + 1 03570060
361: WRITE (I02,80003) IVTNUM 03580060
362: IF (ICZERO) 40100, 111, 40100 03590060
363: 40100 IF (RVCOMP - .64996) 20100,10100,40101 03600060
364: 40101 IF (RVCOMP - .65006) 10100,10100,20100 03610060
365: 10100 IVPASS = IVPASS + 1 03620060
366: WRITE (I02,80001) IVTNUM 03630060
367: GO TO 111 03640060
368: 20100 IVFAIL = IVFAIL + 1 03650060
369: RVCORR = .65001 03660060
370: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03670060
371: 111 CONTINUE 03680060
372: IVTNUM = 11 03690060
373: C 03700060
374: C **** TEST 11 **** 03710060
375: C 03720060
376: IF (ICZERO) 30110, 110, 30110 03730060
377: 110 CONTINUE 03740060
378: RVCOMP = -.33333 03750060
379: GO TO 40110 03760060
380: 30110 IVDELE = IVDELE + 1 03770060
381: WRITE (I02,80003) IVTNUM 03780060
382: IF (ICZERO) 40110, 121, 40110 03790060
383: 40110 IF (RVCOMP + .33338) 20110,10110,40111 03800060
384: 40111 IF (RVCOMP + .33328) 10110,10110,20110 03810060
385: 10110 IVPASS = IVPASS + 1 03820060
386: WRITE (I02,80001) IVTNUM 03830060
387: GO TO 121 03840060
388: 20110 IVFAIL = IVFAIL + 1 03850060
389: RVCORR = -.33333 03860060
390: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03870060
391: C 03880060
392: C TEST 012 THROUGH TEST 19 - REAL CONSTANT IS BASIC REAL CONSTANT 03890060
393: C - FOLLOWED BY DECIMAL EXPONENT 03900060
394: C 03910060
395: 121 CONTINUE 03920060
396: IVTNUM = 12 03930060
397: C 03940060
398: C **** TEST 12 **** 03950060
399: C 03960060
400: IF (ICZERO) 30120, 120, 30120 03970060
401: 120 CONTINUE 03980060
402: RVCOMP = .2E+1 03990060
403: GO TO 40120 04000060
404: 30120 IVDELE = IVDELE + 1 04010060
405: WRITE (I02,80003) IVTNUM 04020060
406: IF (ICZERO) 40120, 131, 40120 04030060
407: 40120 IF (RVCOMP - 1.9995) 20120,10120,40121 04040060
408: 40121 IF (RVCOMP - 2.0005) 10120,10120,20120 04050060
409: 10120 IVPASS = IVPASS + 1 04060060
410: WRITE (I02,80001) IVTNUM 04070060
411: GO TO 131 04080060
412: 20120 IVFAIL = IVFAIL + 1 04090060
413: RVCORR = 2.0 04100060
414: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04110060
415: 131 CONTINUE 04120060
416: IVTNUM = 13 04130060
417: C 04140060
418: C **** TEST 13 **** 04150060
419: C 04160060
420: IF (ICZERO) 30130, 130, 30130 04170060
421: 130 CONTINUE 04180060
422: RVCOMP = 2.0E+0 04190060
423: GO TO 40130 04200060
424: 30130 IVDELE = IVDELE + 1 04210060
425: WRITE (I02,80003) IVTNUM 04220060
426: IF (ICZERO) 40130, 141, 40130 04230060
427: 40130 IF (RVCOMP - 1.9995) 20130,10130,40131 04240060
428: 40131 IF (RVCOMP - 2.0005) 10130,10130,20130 04250060
429: 10130 IVPASS = IVPASS + 1 04260060
430: WRITE (I02,80001) IVTNUM 04270060
431: GO TO 141 04280060
432: 20130 IVFAIL = IVFAIL + 1 04290060
433: RVCORR = 2.0 04300060
434: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04310060
435: 141 CONTINUE 04320060
436: IVTNUM = 14 04330060
437: C 04340060
438: C **** TEST 14 **** 04350060
439: C 04360060
440: IF (ICZERO) 30140, 140, 30140 04370060
441: 140 CONTINUE 04380060
442: RVCOMP = 445.0E-01 04390060
443: GO TO 40140 04400060
444: 30140 IVDELE = IVDELE + 1 04410060
445: WRITE (I02,80003) IVTNUM 04420060
446: IF (ICZERO) 40140, 151, 40140 04430060
447: 40140 IF (RVCOMP - 44.495) 20140,10140,40141 04440060
448: 40141 IF (RVCOMP - 44.505) 10140,10140,20140 04450060
449: 10140 IVPASS = IVPASS + 1 04460060
450: WRITE (I02,80001) IVTNUM 04470060
451: GO TO 151 04480060
452: 20140 IVFAIL = IVFAIL + 1 04490060
453: RVCORR = 44.5 04500060
454: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04510060
455: 151 CONTINUE 04520060
456: IVTNUM = 15 04530060
457: C 04540060
458: C **** TEST 15 **** 04550060
459: C 04560060
460: IF (ICZERO) 30150, 150, 30150 04570060
461: 150 CONTINUE 04580060
462: RVCOMP = 4.450E1 04590060
463: GO TO 40150 04600060
464: 30150 IVDELE = IVDELE + 1 04610060
465: WRITE (I02,80003) IVTNUM 04620060
466: IF (ICZERO) 40150, 161, 40150 04630060
467: 40150 IF (RVCOMP - 44.495) 20150,10150,40151 04640060
468: 40151 IF (RVCOMP - 44.505) 10150,10150,20150 04650060
469: 10150 IVPASS = IVPASS + 1 04660060
470: WRITE (I02,80001) IVTNUM 04670060
471: GO TO 161 04680060
472: 20150 IVFAIL = IVFAIL + 1 04690060
473: RVCORR = 44.5 04700060
474: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04710060
475: 161 CONTINUE 04720060
476: IVTNUM = 16 04730060
477: C 04740060
478: C **** TEST 16 **** 04750060
479: C 04760060
480: IF (ICZERO) 30160, 160, 30160 04770060
481: 160 CONTINUE 04780060
482: RVCOMP = 2.E+15 04790060
483: GO TO 40160 04800060
484: 30160 IVDELE = IVDELE + 1 04810060
485: WRITE (I02,80003) IVTNUM 04820060
486: IF (ICZERO) 40160, 171, 40160 04830060
487: 40160 IF (RVCOMP - 1.9995E+15) 20160,10160,40161 04840060
488: 40161 IF (RVCOMP - 2.0005E+15) 10160,10160,20160 04850060
489: 10160 IVPASS = IVPASS + 1 04860060
490: WRITE (I02,80001) IVTNUM 04870060
491: GO TO 171 04880060
492: 20160 IVFAIL = IVFAIL + 1 04890060
493: RVCORR = 2.0E+15 04900060
494: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04910060
495: 171 CONTINUE 04920060
496: IVTNUM = 17 04930060
497: C 04940060
498: C **** TEST 17 **** 04950060
499: C 04960060
500: IF (ICZERO) 30170, 170, 30170 04970060
501: 170 CONTINUE 04980060
502: RVCOMP = 44.5E-15 04990060
503: GO TO 40170 05000060
504: 30170 IVDELE = IVDELE + 1 05010060
505: WRITE (I02,80003) IVTNUM 05020060
506: IF (ICZERO) 40170, 181, 40170 05030060
507: 40170 IF (RVCOMP - 44.495E-15) 20170,10170,40171 05040060
508: 40171 IF (RVCOMP - 44.505E-15) 10170,10170,20170 05050060
509: 10170 IVPASS = IVPASS + 1 05060060
510: WRITE (I02,80001) IVTNUM 05070060
511: GO TO 181 05080060
512: 20170 IVFAIL = IVFAIL + 1 05090060
513: RVCORR = 44.5E-15 05100060
514: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05110060
515: 181 CONTINUE 05120060
516: IVTNUM = 18 05130060
517: C 05140060
518: C **** TEST 18 **** 05150060
519: C 05160060
520: IF (ICZERO) 30180, 180, 30180 05170060
521: 180 CONTINUE 05180060
522: RVCOMP = -4.45E0 05190060
523: GO TO 40180 05200060
524: 30180 IVDELE = IVDELE + 1 05210060
525: WRITE (I02,80003) IVTNUM 05220060
526: IF (ICZERO) 40180, 191, 40180 05230060
527: 40180 IF (RVCOMP + 4.4505) 20180,10180,40181 05240060
528: 40181 IF (RVCOMP + 4.4495) 10180,10180,20180 05250060
529: 10180 IVPASS = IVPASS + 1 05260060
530: WRITE (I02,80001) IVTNUM 05270060
531: GO TO 191 05280060
532: 20180 IVFAIL = IVFAIL + 1 05290060
533: RVCORR = -4.45 05300060
534: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05310060
535: 191 CONTINUE 05320060
536: IVTNUM = 19 05330060
537: C 05340060
538: C **** TEST 19 **** 05350060
539: C 05360060
540: IF (ICZERO) 30190, 190, 30190 05370060
541: 190 CONTINUE 05380060
542: RVCOMP = -6511.8E-0 05390060
543: GO TO 40190 05400060
544: 30190 IVDELE = IVDELE + 1 05410060
545: WRITE (I02,80003) IVTNUM 05420060
546: IF (ICZERO) 40190, 201, 40190 05430060
547: 40190 IF (RVCOMP + 6512.3) 20190,10190,40191 05440060
548: 40191 IF (RVCOMP + 6511.3) 10190,10190,20190 05450060
549: 10190 IVPASS = IVPASS + 1 05460060
550: WRITE (I02,80001) IVTNUM 05470060
551: GO TO 201 05480060
552: 20190 IVFAIL = IVFAIL + 1 05490060
553: RVCORR = -6511.8 05500060
554: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05510060
555: C 05520060
556: C TEST 020 THROUGH TEST 025 - INTEGER CONSTANT FOLLOWED 05530060
557: C - BY A DECIMAL EXPONENT 05540060
558: C 05550060
559: 201 CONTINUE 05560060
560: IVTNUM = 20 05570060
561: C 05580060
562: C **** TEST 20 **** 05590060
563: C 05600060
564: IF (ICZERO) 30200, 200, 30200 05610060
565: 200 CONTINUE 05620060
566: RVCOMP = 2E+1 05630060
567: GO TO 40200 05640060
568: 30200 IVDELE = IVDELE + 1 05650060
569: WRITE (I02,80003) IVTNUM 05660060
570: IF (ICZERO) 40200, 211, 40200 05670060
571: 40200 IF (RVCOMP - 19.995) 20200,10200,40201 05680060
572: 40201 IF (RVCOMP - 20.005) 10200,10200,20200 05690060
573: 10200 IVPASS = IVPASS + 1 05700060
574: WRITE (I02,80001) IVTNUM 05710060
575: GO TO 211 05720060
576: 20200 IVFAIL = IVFAIL + 1 05730060
577: RVCORR = 20.0 05740060
578: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05750060
579: 211 CONTINUE 05760060
580: IVTNUM = 21 05770060
581: C 05780060
582: C **** TEST 21 **** 05790060
583: C 05800060
584: IF (ICZERO) 30210, 210, 30210 05810060
585: 210 CONTINUE 05820060
586: RVCOMP = 445E-02 05830060
587: GO TO 40210 05840060
588: 30210 IVDELE = IVDELE + 1 05850060
589: WRITE (I02,80003) IVTNUM 05860060
590: IF (ICZERO) 40210, 221, 40210 05870060
591: 40210 IF (RVCOMP - 4.4495) 20210,10210,40211 05880060
592: 40211 IF (RVCOMP - 4.4505) 10210,10210,20210 05890060
593: 10210 IVPASS = IVPASS + 1 05900060
594: WRITE (I02,80001) IVTNUM 05910060
595: GO TO 221 05920060
596: 20210 IVFAIL = IVFAIL + 1 05930060
597: RVCORR = 4.45 05940060
598: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05950060
599: 221 CONTINUE 05960060
600: IVTNUM = 22 05970060
601: C 05980060
602: C **** TEST 22 **** 05990060
603: C 06000060
604: IF (ICZERO) 30220, 220, 30220 06010060
605: 220 CONTINUE 06020060
606: RVCOMP = 7E3 06030060
607: GO TO 40220 06040060
608: 30220 IVDELE = IVDELE + 1 06050060
609: WRITE (I02,80003) IVTNUM 06060060
610: IF (ICZERO) 40220, 231, 40220 06070060
611: 40220 IF (RVCOMP - 6999.0) 20220,10220,40221 06080060
612: 40221 IF (RVCOMP - 7001.0) 10220,10220,20220 06090060
613: 10220 IVPASS = IVPASS + 1 06100060
614: WRITE (I02,80001) IVTNUM 06110060
615: GO TO 231 06120060
616: 20220 IVFAIL = IVFAIL + 1 06130060
617: RVCORR = 7000.0 06140060
618: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06150060
619: 231 CONTINUE 06160060
620: IVTNUM = 23 06170060
621: C 06180060
622: C **** TEST 23 **** 06190060
623: C 06200060
624: IF (ICZERO) 30230, 230, 30230 06210060
625: 230 CONTINUE 06220060
626: RVCOMP = 214 E 0 06230060
627: GO TO 40230 06240060
628: 30230 IVDELE = IVDELE + 1 06250060
629: WRITE (I02,80003) IVTNUM 06260060
630: IF (ICZERO) 40230, 241, 40230 06270060
631: 40230 IF (RVCOMP - 213.95) 20230,10230,40231 06280060
632: 40231 IF (RVCOMP - 214.05) 10230,10230,20230 06290060
633: 10230 IVPASS = IVPASS + 1 06300060
634: WRITE (I02,80001) IVTNUM 06310060
635: GO TO 241 06320060
636: 20230 IVFAIL = IVFAIL + 1 06330060
637: RVCORR = 214.0 06340060
638: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06350060
639: 241 CONTINUE 06360060
640: IVTNUM = 24 06370060
641: C 06380060
642: C **** TEST 24 **** 06390060
643: C 06400060
644: IF (ICZERO) 30240, 240, 30240 06410060
645: 240 CONTINUE 06420060
646: RVCOMP = -3276E+6 06430060
647: GO TO 40240 06440060
648: 30240 IVDELE = IVDELE + 1 06450060
649: WRITE (I02,80003) IVTNUM 06460060
650: IF (ICZERO) 40240, 251, 40240 06470060
651: 40240 IF (RVCOMP + .32765E+10) 20240,10240,40241 06480060
652: 40241 IF (RVCOMP + .32755E+10) 10240,10240,20240 06490060
653: 10240 IVPASS = IVPASS + 1 06500060
654: WRITE (I02,80001) IVTNUM 06510060
655: GO TO 251 06520060
656: 20240 IVFAIL = IVFAIL + 1 06530060
657: RVCORR = -3276E+6 06540060
658: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06550060
659: 251 CONTINUE 06560060
660: IVTNUM = 25 06570060
661: C 06580060
662: C **** TEST 25 **** 06590060
663: C 06600060
664: IF (ICZERO) 30250, 250, 30250 06610060
665: 250 CONTINUE 06620060
666: RVCOMP = -7E3 06630060
667: GO TO 40250 06640060
668: 30250 IVDELE = IVDELE + 1 06650060
669: WRITE (I02,80003) IVTNUM 06660060
670: IF (ICZERO) 40250, 261, 40250 06670060
671: 40250 IF (RVCOMP + 7001.) 20250,10250,40251 06680060
672: 40251 IF (RVCOMP + 6999.) 10250,10250,20250 06690060
673: 10250 IVPASS = IVPASS + 1 06700060
674: WRITE (I02,80001) IVTNUM 06710060
675: GO TO 261 06720060
676: 20250 IVFAIL = IVFAIL + 1 06730060
677: RVCORR = -7000.0 06740060
678: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06750060
679: C 06760060
680: C TEST 026 THROUGH TEST 028 CONTAIN ARITHMETIC ASSIGNMENT STATEMENT 06770060
681: C OF THE FORM REAL VARIABLE = REAL VARIABLE 06780060
682: C 06790060
683: 261 CONTINUE 06800060
684: IVTNUM = 26 06810060
685: C 06820060
686: C **** TEST 26 **** 06830060
687: C 06840060
688: IF (ICZERO) 30260, 260, 30260 06850060
689: 260 CONTINUE 06860060
690: RVON01 = .2E+1 06870060
691: RVCOMP = RVON01 06880060
692: GO TO 40260 06890060
693: 30260 IVDELE = IVDELE + 1 06900060
694: WRITE (I02,80003) IVTNUM 06910060
695: IF (ICZERO) 40260, 271, 40260 06920060
696: 40260 IF (RVCOMP - 1.9995) 20260,10260,40261 06930060
697: 40261 IF (RVCOMP - 2.0005) 10260,10260,20260 06940060
698: 10260 IVPASS = IVPASS + 1 06950060
699: WRITE (I02,80001) IVTNUM 06960060
700: GO TO 271 06970060
701: 20260 IVFAIL = IVFAIL + 1 06980060
702: RVCORR = 20.0 06990060
703: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07000060
704: 271 CONTINUE 07010060
705: IVTNUM = 27 07020060
706: C 07030060
707: C **** TEST 27 **** 07040060
708: C 07050060
709: IF (ICZERO) 30270, 270, 30270 07060060
710: 270 CONTINUE 07070060
711: RVON01 = -445.E-01 07080060
712: RVCOMP = RVON01 07090060
713: GO TO 40270 07100060
714: 30270 IVDELE = IVDELE + 1 07110060
715: WRITE (I02,80003) IVTNUM 07120060
716: IF (ICZERO) 40270, 281, 40270 07130060
717: 40270 IF (RVCOMP + 44.505) 20270,10270,40271 07140060
718: 40271 IF (RVCOMP + 44.495) 10270,10270,20270 07150060
719: 10270 IVPASS = IVPASS + 1 07160060
720: WRITE (I02,80001) IVTNUM 07170060
721: GO TO 281 07180060
722: 20270 IVFAIL = IVFAIL + 1 07190060
723: RVCORR = -44.5 07200060
724: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07210060
725: 281 CONTINUE 07220060
726: IVTNUM = 28 07230060
727: C 07240060
728: C **** TEST 28 **** 07250060
729: C 07260060
730: IF (ICZERO) 30280, 280, 30280 07270060
731: 280 CONTINUE 07280060
732: RVON01 = 7E3 07290060
733: RVCOMP = RVON01 07300060
734: GO TO 40280 07310060
735: 30280 IVDELE = IVDELE + 1 07320060
736: WRITE (I02,80003) IVTNUM 07330060
737: IF (ICZERO) 40280, 291, 40280 07340060
738: 40280 IF (RVCOMP - 6999.0) 20280,10280,40281 07350060
739: 40281 IF (RVCOMP-7001.0) 10280,10280,20280 07360060
740: 10280 IVPASS = IVPASS + 1 07370060
741: WRITE (I02,80001) IVTNUM 07380060
742: GO TO 291 07390060
743: 20280 IVFAIL = IVFAIL + 1 07400060
744: RVCORR = 7000.0 07410060
745: C 07420060
746: C TEST 029 THROUGH TEST 031 CONTAIN ARITHMETIC ASSIGNMENT STATEMENT 07430060
747: C OF THE FORM REAL VARIABLE = - REAL VARIABLE 07440060
748: C 07450060
749: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07460060
750: 291 CONTINUE 07470060
751: IVTNUM = 29 07480060
752: C 07490060
753: C **** TEST 29 **** 07500060
754: C 07510060
755: IF (ICZERO) 30290, 290, 30290 07520060
756: 290 CONTINUE 07530060
757: RVON01 = .2E+1 07540060
758: RVCOMP = -RVON01 07550060
759: GO TO 40290 07560060
760: 30290 IVDELE = IVDELE + 1 07570060
761: WRITE (I02,80003) IVTNUM 07580060
762: IF (ICZERO) 40290, 301, 40290 07590060
763: 40290 IF (RVCOMP + 2.0005) 20290,10290,40291 07600060
764: 40291 IF (RVCOMP + 1.9995) 10290,10290,20290 07610060
765: 10290 IVPASS = IVPASS + 1 07620060
766: WRITE (I02,80001) IVTNUM 07630060
767: GO TO 301 07640060
768: 20290 IVFAIL = IVFAIL + 1 07650060
769: RVCORR = -2.0 07660060
770: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07670060
771: 301 CONTINUE 07680060
772: IVTNUM = 30 07690060
773: C 07700060
774: C **** TEST 30 **** 07710060
775: C 07720060
776: IF (ICZERO) 30300, 300, 30300 07730060
777: 300 CONTINUE 07740060
778: RVON01 = -445.E-01 07750060
779: RVCOMP = -RVON01 07760060
780: GO TO 40300 07770060
781: 30300 IVDELE = IVDELE + 1 07780060
782: WRITE (I02,80003) IVTNUM 07790060
783: IF (ICZERO) 40300, 311, 40300 07800060
784: 40300 IF (RVCOMP - 44.495) 20300,10300,40301 07810060
785: 40301 IF (RVCOMP - 44.505) 10300,10300,20300 07820060
786: 10300 IVPASS = IVPASS + 1 07830060
787: WRITE (I02,80001) IVTNUM 07840060
788: GO TO 311 07850060
789: 20300 IVFAIL = IVFAIL + 1 07860060
790: RVCORR = 44.5 07870060
791: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07880060
792: 311 CONTINUE 07890060
793: IVTNUM = 31 07900060
794: C 07910060
795: C **** TEST 31 **** 07920060
796: C 07930060
797: IF (ICZERO) 30310, 310, 30310 07940060
798: 310 CONTINUE 07950060
799: RVON01 = -.44559E1 07960060
800: RVCOMP = -RVON01 07970060
801: GO TO 40310 07980060
802: 30310 IVDELE = IVDELE + 1 07990060
803: WRITE (I02,80003) IVTNUM 08000060
804: IF (ICZERO) 40310, 321, 40310 08010060
805: 40310 IF (RVCOMP - 4.4554) 20310,10310,40311 08020060
806: 40311 IF (RVCOMP - 4.4564) 10310,10310,20310 08030060
807: 10310 IVPASS = IVPASS + 1 08040060
808: WRITE (I02,80001) IVTNUM 08050060
809: GO TO 321 08060060
810: 20310 IVFAIL = IVFAIL + 1 08070060
811: RVCORR = 4.4559 08080060
812: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08090060
813: C **** END OF TESTS **** 08100060
814: 321 CONTINUE 08110060
815: C 08120060
816: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08130060
817: 99999 CONTINUE 08140060
818: WRITE (I02,90002) 08150060
819: WRITE (I02,90006) 08160060
820: WRITE (I02,90002) 08170060
821: WRITE (I02,90002) 08180060
822: WRITE (I02,90007) 08190060
823: WRITE (I02,90002) 08200060
824: WRITE (I02,90008) IVFAIL 08210060
825: WRITE (I02,90009) IVPASS 08220060
826: WRITE (I02,90010) IVDELE 08230060
827: C 08240060
828: C 08250060
829: C TERMINATE ROUTINE EXECUTION 08260060
830: STOP 08270060
831: C 08280060
832: C FORMAT STATEMENTS FOR PAGE HEADERS 08290060
833: 90000 FORMAT (1H1) 08300060
834: 90002 FORMAT (1H ) 08310060
835: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 08320060
836: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 08330060
837: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 08340060
838: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 08350060
839: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 08360060
840: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 08370060
841: C 08380060
842: C FORMAT STATEMENTS FOR RUN SUMMARIES 08390060
843: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 08400060
844: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 08410060
845: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 08420060
846: C 08430060
847: C FORMAT STATEMENTS FOR TEST RESULTS 08440060
848: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 08450060
849: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 08460060
850: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 08470060
851: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 08480060
852: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 08490060
853: C 08500060
854: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM060) 08510060
855: END 08520060
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.