|
|
1.1 root 1: C COMMENT SECTION 00010061
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 00020061
6: C FM061 00030061
7: C 00040061
8: C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050061
9: C FORM 00060061
10: C INTEGER VARIABLE = REAL CONSTANT 00070061
11: C INTEGER VARIABLE = REAL VARIABLE 00080061
12: C REAL VARIABLE = INTEGER VARIABLE 00090061
13: C REAL VARIABLE = INTEGER CONSTANT 00100061
14: C 00110061
15: C THE CONSTANTS AND VARIABLES CONTAIN BOTH POSITIVE AND NEGATIVE 00120061
16: C VALUES. 00130061
17: C 00140061
18: C A REAL DATUM IS A PROCESSOR APPROXIMATION TO THE VALUE OF A 00150061
19: C REAL NUMBER. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES. 00160061
20: C 00170061
21: C A BASIC REAL CONSTANT IS WRITTEN AS AN INTEGER PART, A 00180061
22: C DECIMAL POINT, AND A DECIMAL FRACTION PART IN THAT ORDER. BOTH 00190061
23: C THE INTEGER PART AND THE DECIMAL PART ARE STRINGS OF DIGITS; 00200061
24: C EITHER ONE OF THESE STRINGS MAY BE EMPTY BUT NOT BOTH. THE 00210061
25: C CONSTANT IS AN APPROXIMATION TO THE DIGIT STRING INTERPRETED AS A 00220061
26: C DECIMAL NUMERAL. 00230061
27: C 00240061
28: C A DECIMAL EXPONENT IS WRITTEN AS THE LETTER E, FOLLOWED BY AN 00250061
29: C OPTIONALLY SIGNED INTEGER CONSTANT. 00260061
30: C 00270061
31: C A REAL CONSTANT IS INDICATED BY WRITING A BASIC REAL CONSTANT,00280061
32: C A BASIC REAL CONSTANT FOLLOWED BY A DECIMAL EXPONENT, OR AN 00290061
33: C INTEGER CONSTANT FOLLOWED BY A DECIMAL EXPONENT. 00300061
34: C 00310061
35: C REFERENCES 00320061
36: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00330061
37: C X3.9-1978 00340061
38: C 00350061
39: C SECTION 4.4, REAL TYPE 00360061
40: C SECTION 4.4.1, REAL CONSTANT 00370061
41: C SECTION 6.1, ARITHMETIC EXPRESSIONS 00380061
42: C SECTION 6.6, EVALUATION OF EXPRESSIONS 00390061
43: C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00400061
44: C SECTION 11.4, ARITHMETIC IF STATEMENT 00410061
45: C 00420061
46: C ********************************************************** 00430061
47: C 00440061
48: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00450061
49: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00460061
50: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00470061
51: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00480061
52: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00490061
53: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00500061
54: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00510061
55: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00520061
56: C OF EXECUTING THESE TESTS. 00530061
57: C 00540061
58: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00550061
59: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00560061
60: C 00570061
61: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00580061
62: C 00590061
63: C DEPARTMENT OF THE NAVY 00600061
64: C FEDERAL COBOL COMPILER TESTING SERVICE 00610061
65: C WASHINGTON, D.C. 20376 00620061
66: C 00630061
67: C ********************************************************** 00640061
68: C 00650061
69: C 00660061
70: C 00670061
71: C INITIALIZATION SECTION 00680061
72: C 00690061
73: C INITIALIZE CONSTANTS 00700061
74: C ************** 00710061
75: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00720061
76: I01 = 5 00730061
77: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00740061
78: I02 = 6 00750061
79: C SYSTEM ENVIRONMENT SECTION 00760061
80: C 00770061
81: I01 = 5 00780061
82: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00790061
83: C (UNIT NUMBER FOR CARD READER). 00800061
84: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00810061
85: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00820061
86: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00830061
87: C 00840061
88: I02 = 6 00850061
89: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00860061
90: C (UNIT NUMBER FOR PRINTER). 00870061
91: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00880061
92: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00890061
93: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00900061
94: C 00910061
95: IVPASS=0 00920061
96: IVFAIL=0 00930061
97: IVDELE=0 00940061
98: ICZERO=0 00950061
99: C 00960061
100: C WRITE PAGE HEADERS 00970061
101: WRITE (I02,90000) 00980061
102: WRITE (I02,90001) 00990061
103: WRITE (I02,90002) 01000061
104: WRITE (I02, 90002) 01010061
105: WRITE (I02,90003) 01020061
106: WRITE (I02,90002) 01030061
107: WRITE (I02,90004) 01040061
108: WRITE (I02,90002) 01050061
109: WRITE (I02,90011) 01060061
110: WRITE (I02,90002) 01070061
111: WRITE (I02,90002) 01080061
112: WRITE (I02,90005) 01090061
113: WRITE (I02,90006) 01100061
114: WRITE (I02,90002) 01110061
115: C 01120061
116: C TEST SECTION 01130061
117: C 01140061
118: C TEST 32 THROUGH TEST 42 CONTAIN ARITHMETIC ASSIGNMENT 01150061
119: C STATEMENTS OF THE FORM 01160061
120: C 01170061
121: C INTEGER VARIABLE = REAL VARIABLE 01180061
122: C 01190061
123: IVTNUM = 32 01200061
124: C 01210061
125: C **** TEST 32 **** 01220061
126: C 01230061
127: IF (ICZERO) 30320, 320, 30320 01240061
128: 320 CONTINUE 01250061
129: RVON01 = 44.5 01260061
130: IVCOMP = RVON01 01270061
131: GO TO 40320 01280061
132: 30320 IVDELE = IVDELE + 1 01290061
133: WRITE (I02,80003) IVTNUM 01300061
134: IF (ICZERO) 40320, 331, 40320 01310061
135: 40320 IF (IVCOMP - 44) 20320,10320,20320 01320061
136: 10320 IVPASS = IVPASS + 1 01330061
137: WRITE (I02,80001) IVTNUM 01340061
138: GO TO 331 01350061
139: 20320 IVFAIL = IVFAIL + 1 01360061
140: IVCORR = 44 01370061
141: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01380061
142: 331 CONTINUE 01390061
143: IVTNUM = 33 01400061
144: C 01410061
145: C **** TEST 33 **** 01420061
146: C 01430061
147: IF (ICZERO) 30330, 330, 30330 01440061
148: 330 CONTINUE 01450061
149: RVON01 = -2.0005 01460061
150: IVCOMP = RVON01 01470061
151: GO TO 40330 01480061
152: 30330 IVDELE = IVDELE + 1 01490061
153: WRITE (I02,80003) IVTNUM 01500061
154: IF (ICZERO) 40330, 341, 40330 01510061
155: 40330 IF (IVCOMP + 2) 20330,10330,20330 01520061
156: 10330 IVPASS = IVPASS + 1 01530061
157: WRITE (I02,80001) IVTNUM 01540061
158: GO TO 341 01550061
159: 20330 IVFAIL = IVFAIL + 1 01560061
160: IVCORR = -2 01570061
161: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01580061
162: 341 CONTINUE 01590061
163: IVTNUM = 34 01600061
164: C 01610061
165: C **** TEST 34 **** 01620061
166: C 01630061
167: IF (ICZERO) 30340, 340, 30340 01640061
168: 340 CONTINUE 01650061
169: RVON01 = .32767 01660061
170: IVCOMP = RVON01 01670061
171: GO TO 40340 01680061
172: 30340 IVDELE = IVDELE + 1 01690061
173: WRITE (I02,80003) IVTNUM 01700061
174: IF (ICZERO) 40340, 351, 40340 01710061
175: 40340 IF (IVCOMP) 20340,10340,20340 01720061
176: 10340 IVPASS = IVPASS + 1 01730061
177: WRITE (I02,80001) IVTNUM 01740061
178: GO TO 351 01750061
179: 20340 IVFAIL = IVFAIL + 1 01760061
180: IVCORR = 0 01770061
181: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01780061
182: 351 CONTINUE 01790061
183: IVTNUM = 35 01800061
184: C 01810061
185: C **** TEST 35 **** 01820061
186: C 01830061
187: IF (ICZERO) 30350, 350, 30350 01840061
188: 350 CONTINUE 01850061
189: RVON01 = 1.999 01860061
190: IVCOMP = RVON01 01870061
191: GO TO 40350 01880061
192: 30350 IVDELE = IVDELE + 1 01890061
193: WRITE (I02,80003) IVTNUM 01900061
194: IF (ICZERO) 40350, 361, 40350 01910061
195: 40350 IF (IVCOMP - 1) 20350,10350,20350 01920061
196: 10350 IVPASS = IVPASS + 1 01930061
197: WRITE (I02,80001) IVTNUM 01940061
198: GO TO 361 01950061
199: 20350 IVFAIL = IVFAIL + 1 01960061
200: IVCORR = 1 01970061
201: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01980061
202: 361 CONTINUE 01990061
203: IVTNUM = 36 02000061
204: C 02010061
205: C **** TEST 36 **** 02020061
206: C 02030061
207: IF (ICZERO) 30360, 360, 30360 02040061
208: 360 CONTINUE 02050061
209: RVON01 = .25E+1 02060061
210: IVCOMP = RVON01 02070061
211: GO TO 40360 02080061
212: 30360 IVDELE = IVDELE + 1 02090061
213: WRITE (I02,80003) IVTNUM 02100061
214: IF (ICZERO) 40360, 371, 40360 02110061
215: 40360 IF (IVCOMP - 2) 20360,10360,20360 02120061
216: 10360 IVPASS = IVPASS + 1 02130061
217: WRITE (I02,80001) IVTNUM 02140061
218: GO TO 371 02150061
219: 20360 IVFAIL = IVFAIL + 1 02160061
220: IVCORR = 2 02170061
221: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02180061
222: 371 CONTINUE 02190061
223: IVTNUM = 37 02200061
224: C 02210061
225: C **** TEST 37 **** 02220061
226: C 02230061
227: IF (ICZERO) 30370, 370, 30370 02240061
228: 370 CONTINUE 02250061
229: RVON01 = 445.0E-01 02260061
230: IVCOMP = RVON01 02270061
231: GO TO 40370 02280061
232: 30370 IVDELE = IVDELE + 1 02290061
233: WRITE (I02,80003) IVTNUM 02300061
234: IF (ICZERO) 40370, 381, 40370 02310061
235: 40370 IF (IVCOMP - 44) 20370,10370,20370 02320061
236: 10370 IVPASS = IVPASS + 1 02330061
237: WRITE (I02,80001) IVTNUM 02340061
238: GO TO 381 02350061
239: 20370 IVFAIL = IVFAIL + 1 02360061
240: IVCORR = 44 02370061
241: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02380061
242: 381 CONTINUE 02390061
243: IVTNUM = 38 02400061
244: C 02410061
245: C **** TEST 38 **** 02420061
246: C 02430061
247: IF (ICZERO) 30380, 380, 30380 02440061
248: 380 CONTINUE 02450061
249: RVON01 = -651.1E-0 02460061
250: IVCOMP = RVON01 02470061
251: GO TO 40380 02480061
252: 30380 IVDELE = IVDELE + 1 02490061
253: WRITE (I02,80003) IVTNUM 02500061
254: IF (ICZERO) 40380, 391, 40380 02510061
255: 40380 IF (IVCOMP + 651) 20380,10380,20380 02520061
256: 10380 IVPASS = IVPASS + 1 02530061
257: WRITE (I02,80001) IVTNUM 02540061
258: GO TO 391 02550061
259: 20380 IVFAIL = IVFAIL + 1 02560061
260: IVCORR = -651 02570061
261: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02580061
262: 391 CONTINUE 02590061
263: IVTNUM = 39 02600061
264: C 02610061
265: C **** TEST 39 **** 02620061
266: C 02630061
267: IF (ICZERO) 30390, 390, 30390 02640061
268: 390 CONTINUE 02650061
269: RVON01 = .3266E4 02660061
270: IVCOMP = RVON01 02670061
271: GO TO 40390 02680061
272: 30390 IVDELE = IVDELE + 1 02690061
273: WRITE (I02,80003) IVTNUM 02700061
274: IF (ICZERO) 40390, 401, 40390 02710061
275: 40390 IF (IVCOMP - 3266) 20390,10390,20390 02720061
276: 10390 IVPASS = IVPASS + 1 02730061
277: WRITE (I02,80001) IVTNUM 02740061
278: GO TO 401 02750061
279: 20390 IVFAIL = IVFAIL + 1 02760061
280: IVCORR = 3266 02770061
281: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02780061
282: 401 CONTINUE 02790061
283: IVTNUM = 40 02800061
284: C 02810061
285: C **** TEST 40 **** 02820061
286: C 02830061
287: IF (ICZERO) 30400, 400, 30400 02840061
288: 400 CONTINUE 02850061
289: RVON01 = 35.43E-01 02860061
290: IVCOMP = RVON01 02870061
291: GO TO 40400 02880061
292: 30400 IVDELE = IVDELE + 1 02890061
293: WRITE (I02,80003) IVTNUM 02900061
294: IF (ICZERO) 40400, 411, 40400 02910061
295: 40400 IF (IVCOMP - 3) 20400,10400,20400 02920061
296: 10400 IVPASS = IVPASS + 1 02930061
297: WRITE (I02,80001) IVTNUM 02940061
298: GO TO 411 02950061
299: 20400 IVFAIL = IVFAIL + 1 02960061
300: IVCORR = 3 02970061
301: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02980061
302: 411 CONTINUE 02990061
303: IVTNUM = 41 03000061
304: C 03010061
305: C **** TEST 41 **** 03020061
306: C 03030061
307: IF (ICZERO) 30410, 410, 30410 03040061
308: 410 CONTINUE 03050061
309: RVON01 = -7.001E2 03060061
310: IVCOMP = RVON01 03070061
311: GO TO 40410 03080061
312: 30410 IVDELE = IVDELE + 1 03090061
313: WRITE (I02,80003) IVTNUM 03100061
314: IF (ICZERO) 40410, 421, 40410 03110061
315: 40410 IF (IVCOMP + 700) 20410,10410,20410 03120061
316: 10410 IVPASS = IVPASS + 1 03130061
317: WRITE (I02,80001) IVTNUM 03140061
318: GO TO 421 03150061
319: 20410 IVFAIL = IVFAIL + 1 03160061
320: IVCORR = -700 03170061
321: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03180061
322: 421 CONTINUE 03190061
323: IVTNUM = 42 03200061
324: C 03210061
325: C **** TEST 42 **** 03220061
326: C 03230061
327: IF (ICZERO) 30420, 420, 30420 03240061
328: 420 CONTINUE 03250061
329: RVON01 = 4.45E-02 03260061
330: IVCOMP = RVON01 03270061
331: GO TO 40420 03280061
332: 30420 IVDELE = IVDELE + 1 03290061
333: WRITE (I02,80003) IVTNUM 03300061
334: IF (ICZERO) 40420, 431, 40420 03310061
335: 40420 IF (IVCOMP) 20420,10420,20420 03320061
336: 10420 IVPASS = IVPASS + 1 03330061
337: WRITE (I02,80001) IVTNUM 03340061
338: GO TO 431 03350061
339: 20420 IVFAIL = IVFAIL + 1 03360061
340: IVCORR = 0 03370061
341: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03380061
342: C TEST 43 THROUGH TEST 48 CONTAIN ARITHMETIC ASSIGNMENT 03390061
343: C STATEMENTS OF THE FORM 03400061
344: C 03410061
345: C REAL VARIABLE = INTEGER VARIABLE 03420061
346: C 03430061
347: 431 CONTINUE 03440061
348: IVTNUM = 43 03450061
349: C 03460061
350: C **** TEST 43 **** 03470061
351: C 03480061
352: IF (ICZERO) 30430, 430, 30430 03490061
353: 430 CONTINUE 03500061
354: IVON01 = 2 03510061
355: RVCOMP = IVON01 03520061
356: GO TO 40430 03530061
357: 30430 IVDELE = IVDELE + 1 03540061
358: WRITE (I02,80003) IVTNUM 03550061
359: IF (ICZERO) 40430, 441, 40430 03560061
360: 40430 IF (RVCOMP - 1.9995) 20430,10430,40431 03570061
361: 40431 IF (RVCOMP - 2.0005) 10430,10430,20430 03580061
362: 10430 IVPASS = IVPASS + 1 03590061
363: WRITE (I02,80001) IVTNUM 03600061
364: GO TO 441 03610061
365: 20430 IVFAIL = IVFAIL + 1 03620061
366: RVCORR = 2.0000 03630061
367: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03640061
368: 441 CONTINUE 03650061
369: IVTNUM = 44 03660061
370: C 03670061
371: C **** TEST 44 **** 03680061
372: C 03690061
373: IF (ICZERO) 30440, 440, 30440 03700061
374: 440 CONTINUE 03710061
375: IVON01 = 25 03720061
376: RVCOMP = IVON01 03730061
377: GO TO 40440 03740061
378: 30440 IVDELE = IVDELE + 1 03750061
379: WRITE (I02,80003) IVTNUM 03760061
380: IF (ICZERO) 40440, 451, 40440 03770061
381: 40440 IF (RVCOMP - 24.995) 20440,10440,40441 03780061
382: 40441 IF (RVCOMP - 25.005) 10440,10440,20440 03790061
383: 10440 IVPASS = IVPASS + 1 03800061
384: WRITE (I02,80001) IVTNUM 03810061
385: GO TO 451 03820061
386: 20440 IVFAIL = IVFAIL + 1 03830061
387: RVCORR = 25.000 03840061
388: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03850061
389: 451 CONTINUE 03860061
390: IVTNUM = 45 03870061
391: C 03880061
392: C **** TEST 45 **** 03890061
393: C 03900061
394: IF (ICZERO) 30450, 450, 30450 03910061
395: 450 CONTINUE 03920061
396: IVON01 = 357 03930061
397: RVCOMP = IVON01 03940061
398: GO TO 40450 03950061
399: 30450 IVDELE = IVDELE + 1 03960061
400: WRITE (I02,80003) IVTNUM 03970061
401: IF (ICZERO) 40450, 461, 40450 03980061
402: 40450 IF (RVCOMP - 356.95) 20450,10450,40451 03990061
403: 40451 IF (RVCOMP - 357.05) 10450,10450,20450 04000061
404: 10450 IVPASS = IVPASS + 1 04010061
405: WRITE (I02,80001) IVTNUM 04020061
406: GO TO 461 04030061
407: 20450 IVFAIL = IVFAIL + 1 04040061
408: RVCORR = 357.00 04050061
409: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04060061
410: 461 CONTINUE 04070061
411: IVTNUM = 46 04080061
412: C 04090061
413: C **** TEST 46 **** 04100061
414: C 04110061
415: IF (ICZERO) 30460, 460, 30460 04120061
416: 460 CONTINUE 04130061
417: IVON01 = 4968 04140061
418: RVCOMP = IVON01 04150061
419: GO TO 40460 04160061
420: 30460 IVDELE = IVDELE + 1 04170061
421: WRITE (I02,80003) IVTNUM 04180061
422: IF (ICZERO) 40460, 471, 40460 04190061
423: 40460 IF (RVCOMP - 4967.5) 20460,10460,40461 04200061
424: 40461 IF (RVCOMP - 4968.5) 10460,10460,20460 04210061
425: 10460 IVPASS = IVPASS + 1 04220061
426: WRITE (I02,80001) IVTNUM 04230061
427: GO TO 471 04240061
428: 20460 IVFAIL = IVFAIL + 1 04250061
429: RVCORR = 4968.0 04260061
430: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04270061
431: 471 CONTINUE 04280061
432: IVTNUM = 47 04290061
433: C 04300061
434: C **** TEST 47 **** 04310061
435: C 04320061
436: IF (ICZERO) 30470, 470, 30470 04330061
437: 470 CONTINUE 04340061
438: IVON01 = 32767 04350061
439: RVCOMP = IVON01 04360061
440: GO TO 40470 04370061
441: 30470 IVDELE = IVDELE + 1 04380061
442: WRITE (I02,80003) IVTNUM 04390061
443: IF (ICZERO) 40470, 481, 40470 04400061
444: 40470 IF (RVCOMP - 32762.) 20470,10470,40471 04410061
445: 40471 IF (RVCOMP - 32772.) 10470,10470,20470 04420061
446: 10470 IVPASS = IVPASS + 1 04430061
447: WRITE (I02,80001) IVTNUM 04440061
448: GO TO 481 04450061
449: 20470 IVFAIL = IVFAIL + 1 04460061
450: RVCORR = 32767. 04470061
451: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04480061
452: 481 CONTINUE 04490061
453: IVTNUM = 48 04500061
454: C 04510061
455: C **** TEST 48 **** 04520061
456: C 04530061
457: IF (ICZERO) 30480, 480, 30480 04540061
458: 480 CONTINUE 04550061
459: IVON01 = -2 04560061
460: RVCOMP = IVON01 04570061
461: GO TO 40480 04580061
462: 30480 IVDELE = IVDELE + 1 04590061
463: WRITE (I02,80003) IVTNUM 04600061
464: IF (ICZERO) 40480, 491, 40480 04610061
465: 40480 IF (RVCOMP + 2.0005) 20480,10480,40481 04620061
466: 40481 IF (RVCOMP + 1.9995) 10480,10480,20450 04630061
467: 10480 IVPASS = IVPASS + 1 04640061
468: WRITE (I02,80001) IVTNUM 04650061
469: GO TO 491 04660061
470: 20480 IVFAIL = IVFAIL + 1 04670061
471: RVCORR = -2.0000 04680061
472: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04690061
473: C 04700061
474: C TEST 49 THROUGH TEST 51 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS 04710061
475: C OF THE FORM 04720061
476: C INTEGER VARIABLE = REAL CONSTANT 04730061
477: C WHERE CONSTANT IS BASIC REAL CONSTANT 04740061
478: C 04750061
479: 491 CONTINUE 04760061
480: IVTNUM = 49 04770061
481: C 04780061
482: C **** TEST 49 **** 04790061
483: C 04800061
484: IF (ICZERO) 30490, 490, 30490 04810061
485: 490 CONTINUE 04820061
486: IVCOMP = 44.5 04830061
487: GO TO 40490 04840061
488: 30490 IVDELE = IVDELE + 1 04850061
489: WRITE (I02,80003) IVTNUM 04860061
490: IF (ICZERO) 40490, 501, 40490 04870061
491: 40490 IF (IVCOMP - 44) 20490,10490,20490 04880061
492: 10490 IVPASS = IVPASS + 1 04890061
493: WRITE (I02,80001) IVTNUM 04900061
494: GO TO 501 04910061
495: 20490 IVFAIL = IVFAIL + 1 04920061
496: IVCORR = 44 04930061
497: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04940061
498: 501 CONTINUE 04950061
499: IVTNUM = 50 04960061
500: C 04970061
501: C **** TEST 50 **** 04980061
502: C 04990061
503: IF (ICZERO) 30500, 500, 30500 05000061
504: 500 CONTINUE 05010061
505: IVCOMP = 6500.1 05020061
506: GO TO 40500 05030061
507: 30500 IVDELE = IVDELE + 1 05040061
508: WRITE (I02,80003) IVTNUM 05050061
509: IF (ICZERO) 40500, 511, 40500 05060061
510: 40500 IF (IVCOMP - 6500) 20500,10500,20500 05070061
511: 10500 IVPASS = IVPASS + 1 05080061
512: WRITE (I02,80001) IVTNUM 05090061
513: GO TO 511 05100061
514: 20500 IVFAIL = IVFAIL + 1 05110061
515: IVCORR = 6500 05120061
516: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05130061
517: 511 CONTINUE 05140061
518: IVTNUM = 51 05150061
519: C 05160061
520: C **** TEST 51 **** 05170061
521: C 05180061
522: IF (ICZERO) 30510, 510, 30510 05190061
523: 510 CONTINUE 05200061
524: IVCOMP = -.33333 05210061
525: GO TO 40510 05220061
526: 30510 IVDELE = IVDELE + 1 05230061
527: WRITE (I02,80003) IVTNUM 05240061
528: IF (ICZERO) 40510, 521, 40510 05250061
529: 40510 IF (IVCOMP) 20510,10510,20510 05260061
530: 10510 IVPASS = IVPASS + 1 05270061
531: WRITE (I02,80001) IVTNUM 05280061
532: GO TO 521 05290061
533: 20510 IVFAIL = IVFAIL + 1 05300061
534: IVCORR = 0 05310061
535: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05320061
536: C 05330061
537: C TEST 52 THROUGH TEST 55 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS 05340061
538: C OF THE FORM 05350061
539: C INTEGER VARIABLE = REAL CONSTANT 05360061
540: C 05370061
541: C WHERE CONSTANT IS BASIC REAL CONSTANT FOLLOWED BY DECIMAL EXPONENT05380061
542: C 05390061
543: 521 CONTINUE 05400061
544: IVTNUM = 52 05410061
545: C 05420061
546: C **** TEST 52 **** 05430061
547: C 05440061
548: IF (ICZERO) 30520, 520, 30520 05450061
549: 520 CONTINUE 05460061
550: IVCOMP = .21E+1 05470061
551: GO TO 40520 05480061
552: 30520 IVDELE = IVDELE + 1 05490061
553: WRITE (I02,80003) IVTNUM 05500061
554: IF (ICZERO) 40520, 531, 40520 05510061
555: 40520 IF (IVCOMP - 2) 20520,10520,20520 05520061
556: 10520 IVPASS = IVPASS + 1 05530061
557: WRITE (I02,80001) IVTNUM 05540061
558: GO TO 531 05550061
559: 20520 IVFAIL = IVFAIL + 1 05560061
560: IVCORR = 2 05570061
561: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05580061
562: 531 CONTINUE 05590061
563: IVTNUM = 53 05600061
564: C 05610061
565: C **** TEST 53 **** 05620061
566: C 05630061
567: IF (ICZERO) 30530, 530, 30530 05640061
568: 530 CONTINUE 05650061
569: IVCOMP = 445.0E-01 05660061
570: GO TO 40530 05670061
571: 30530 IVDELE = IVDELE + 1 05680061
572: WRITE (I02,80003) IVTNUM 05690061
573: IF (ICZERO) 40530, 541, 40530 05700061
574: 40530 IF (IVCOMP - 44) 20530,10530,20530 05710061
575: 10530 IVPASS = IVPASS + 1 05720061
576: WRITE (I02,80001) IVTNUM 05730061
577: GO TO 541 05740061
578: 20530 IVFAIL = IVFAIL + 1 05750061
579: IVCORR = 44 05760061
580: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05770061
581: 541 CONTINUE 05780061
582: IVTNUM = 54 05790061
583: C 05800061
584: C **** TEST 54 **** 05810061
585: C 05820061
586: IF (ICZERO) 30540, 540, 30540 05830061
587: 540 CONTINUE 05840061
588: IVCOMP = 4.450E1 05850061
589: GO TO 40540 05860061
590: 30540 IVDELE = IVDELE + 1 05870061
591: WRITE (I02,80003) IVTNUM 05880061
592: IF (ICZERO) 40540, 551, 40540 05890061
593: 40540 IF (IVCOMP - 44) 20540,10540,20540 05900061
594: 10540 IVPASS = IVPASS + 1 05910061
595: WRITE (I02,80001) IVTNUM 05920061
596: GO TO 551 05930061
597: 20540 IVFAIL = IVFAIL + 1 05940061
598: IVCORR = 44 05950061
599: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05960061
600: 551 CONTINUE 05970061
601: IVTNUM = 55 05980061
602: C 05990061
603: C **** TEST 55 **** 06000061
604: C 06010061
605: IF (ICZERO) 30550, 550, 30550 06020061
606: 550 CONTINUE 06030061
607: IVCOMP = -4.45E0 06040061
608: GO TO 40550 06050061
609: 30550 IVDELE = IVDELE + 1 06060061
610: WRITE (I02,80003) IVTNUM 06070061
611: IF (ICZERO) 40550, 561, 40550 06080061
612: 40550 IF (IVCOMP + 4) 20550,10550,20550 06090061
613: 10550 IVPASS = IVPASS + 1 06100061
614: WRITE (I02,80001) IVTNUM 06110061
615: GO TO 561 06120061
616: 20550 IVFAIL = IVFAIL + 1 06130061
617: IVCORR = -4 06140061
618: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06150061
619: C 06160061
620: C TEST 56 AND 57 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS OF THE 06170061
621: C FORM INTEGER VARIABLE = REAL CONSTANT 06180061
622: C WHERE CONSTANT IS INTEGER CONSTANT FOLLOWED BY DECIMAL EXPONENT 06190061
623: C 06200061
624: 561 CONTINUE 06210061
625: IVTNUM = 56 06220061
626: C 06230061
627: C **** TEST 56 **** 06240061
628: C 06250061
629: IF (ICZERO) 30560, 560, 30560 06260061
630: 560 CONTINUE 06270061
631: IVCOMP = 445E-02 06280061
632: GO TO 40560 06290061
633: 30560 IVDELE = IVDELE + 1 06300061
634: WRITE (I02,80003) IVTNUM 06310061
635: IF (ICZERO) 40560, 571, 40560 06320061
636: 40560 IF (IVCOMP - 4) 20560,10560,20560 06330061
637: 10560 IVPASS = IVPASS + 1 06340061
638: WRITE (I02,80001) IVTNUM 06350061
639: GO TO 571 06360061
640: 20560 IVFAIL = IVFAIL + 1 06370061
641: IVCORR = 4 06380061
642: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06390061
643: 571 CONTINUE 06400061
644: IVTNUM = 57 06410061
645: C 06420061
646: C **** TEST 57 **** 06430061
647: C 06440061
648: IF (ICZERO) 30570, 570, 30570 06450061
649: 570 CONTINUE 06460061
650: IVCOMP = -701E-1 06470061
651: GO TO 40570 06480061
652: 30570 IVDELE = IVDELE + 1 06490061
653: WRITE (I02,80003) IVTNUM 06500061
654: IF (ICZERO) 40570, 581, 40570 06510061
655: 40570 IF (IVCOMP + 70) 20570,10570,20570 06520061
656: 10570 IVPASS = IVPASS + 1 06530061
657: WRITE (I02,80001) IVTNUM 06540061
658: GO TO 581 06550061
659: 20570 IVFAIL = IVFAIL + 1 06560061
660: IVCORR = -70 06570061
661: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06580061
662: C 06590061
663: C TEST 58 THROUGH TEST 62 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS 06600061
664: C OF THE FORM REAL VARIABLE = INTEGER CONSTANT 06610061
665: C 06620061
666: 581 CONTINUE 06630061
667: IVTNUM = 58 06640061
668: C 06650061
669: C **** TEST 58 **** 06660061
670: C 06670061
671: IF (ICZERO) 30580, 580, 30580 06680061
672: 580 CONTINUE 06690061
673: RVCOMP = 23 06700061
674: GO TO 40580 06710061
675: 30580 IVDELE = IVDELE + 1 06720061
676: WRITE (I02,80003) IVTNUM 06730061
677: IF (ICZERO) 40580, 591, 40580 06740061
678: 40580 IF (RVCOMP - 22.995) 20580,10580,40581 06750061
679: 40581 IF (RVCOMP - 23.005) 10580,10580,20580 06760061
680: 10580 IVPASS = IVPASS + 1 06770061
681: WRITE (I02,80001) IVTNUM 06780061
682: GO TO 591 06790061
683: 20580 IVFAIL = IVFAIL + 1 06800061
684: RVCORR = 23.000 06810061
685: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06820061
686: 591 CONTINUE 06830061
687: IVTNUM = 59 06840061
688: C 06850061
689: C **** TEST 59 **** 06860061
690: C 06870061
691: IF (ICZERO) 30590, 590, 30590 06880061
692: 590 CONTINUE 06890061
693: RVCOMP = 32645 06900061
694: GO TO 40590 06910061
695: 30590 IVDELE = IVDELE + 1 06920061
696: WRITE (I02,80003) IVTNUM 06930061
697: IF (ICZERO) 40590, 601, 40590 06940061
698: 40590 IF (RVCOMP - 32640.) 20590,10590,40591 06950061
699: 40591 IF (RVCOMP - 32650.) 10590,10590,20590 06960061
700: 10590 IVPASS = IVPASS + 1 06970061
701: WRITE (I02,80001) IVTNUM 06980061
702: GO TO 601 06990061
703: 20590 IVFAIL = IVFAIL + 1 07000061
704: RVCORR = 32645. 07010061
705: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07020061
706: 601 CONTINUE 07030061
707: IVTNUM = 60 07040061
708: C 07050061
709: C **** TEST 60 **** 07060061
710: C 07070061
711: IF (ICZERO) 30600, 600, 30600 07080061
712: 600 CONTINUE 07090061
713: RVCOMP = 0 07100061
714: GO TO 40600 07110061
715: 30600 IVDELE = IVDELE + 1 07120061
716: WRITE (I02,80003) IVTNUM 07130061
717: IF (ICZERO) 40600, 611, 40600 07140061
718: 40600 IF (RVCOMP) 20600,10600,20600 07150061
719: 10600 IVPASS = IVPASS + 1 07160061
720: WRITE (I02,80001) IVTNUM 07170061
721: GO TO 611 07180061
722: 20600 IVFAIL = IVFAIL + 1 07190061
723: RVCORR = 00000. 07200061
724: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07210061
725: 611 CONTINUE 07220061
726: IVTNUM = 61 07230061
727: C 07240061
728: C **** TEST 61 **** 07250061
729: C 07260061
730: IF (ICZERO) 30610, 610, 30610 07270061
731: 610 CONTINUE 07280061
732: RVCOMP = -15 07290061
733: GO TO 40610 07300061
734: 30610 IVDELE = IVDELE + 1 07310061
735: WRITE (I02,80003) IVTNUM 07320061
736: IF (ICZERO) 40610, 621, 40610 07330061
737: 40610 IF (RVCOMP -14.995) 40611,10610,20610 07340061
738: 40611 IF (RVCOMP + 15.005) 20610,10610,10610 07350061
739: 10610 IVPASS = IVPASS + 1 07360061
740: WRITE (I02,80001) IVTNUM 07370061
741: GO TO 621 07380061
742: 20610 IVFAIL = IVFAIL + 1 07390061
743: RVCORR = -15.000 07400061
744: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07410061
745: 621 CONTINUE 07420061
746: C 07430061
747: C **** END OF TESTS **** 07440061
748: C 07450061
749: C 07460061
750: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07470061
751: 99999 CONTINUE 07480061
752: WRITE (I02,90002) 07490061
753: WRITE (I02,90006) 07500061
754: WRITE (I02,90002) 07510061
755: WRITE (I02,90002) 07520061
756: WRITE (I02,90007) 07530061
757: WRITE (I02,90002) 07540061
758: WRITE (I02,90008) IVFAIL 07550061
759: WRITE (I02,90009) IVPASS 07560061
760: WRITE (I02,90010) IVDELE 07570061
761: C 07580061
762: C 07590061
763: C TERMINATE ROUTINE EXECUTION 07600061
764: STOP 07610061
765: C 07620061
766: C FORMAT STATEMENTS FOR PAGE HEADERS 07630061
767: 90000 FORMAT (1H1) 07640061
768: 90002 FORMAT (1H ) 07650061
769: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 07660061
770: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 07670061
771: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 07680061
772: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 07690061
773: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 07700061
774: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 07710061
775: C 07720061
776: C FORMAT STATEMENTS FOR RUN SUMMARIES 07730061
777: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 07740061
778: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 07750061
779: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 07760061
780: C 07770061
781: C FORMAT STATEMENTS FOR TEST RESULTS 07780061
782: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 07790061
783: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 07800061
784: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 07810061
785: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 07820061
786: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 07830061
787: C 07840061
788: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM061) 07850061
789: END 07860061
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.