|
|
1.1 root 1: C COMMENT SECTION. 00010108
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 00020108
6: C FM108 00030108
7: C 00040108
8: C THIS ROUTINE IS A TEST OF THE X FORMAT AND IS TAPE AND PRINTER00050108
9: C ORIENTED. THE ROUTINE CAN NOT BE USED FOR DISK. BOTH THE READ 00060108
10: C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070108
11: C OUTPUT LISTS ARE INTEGER OR REAL VARIABLES, INTEGER ARRAY ELEMENTS00080108
12: C OR ARRAY NAME REFERENCES. READ AND WRITE STATEMENTS ARE DONE 00090108
13: C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100108
14: C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110108
15: C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120108
16: C INTEGER ARRAY FOR THE DUMP SECTION. 00130108
17: C 00140108
18: C WITH THE EXCEPTION OF THE RECORD PREAMBLES ON EACH RECORD, 00150108
19: C ALL OF THE I, F, AND A-FIELDS HAVE A MINUS SIGN IN THE LEFTMOST 00160108
20: C CHARACTER POSITION OF EACH FIELD. 00170108
21: C 00180108
22: C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00190108
23: C REWOUND AND READ SEQUENTIALLY FORWARD AND THEN READ SEQUENTIALLY 00200108
24: C BACKWARD BY USING THE BACKSPACE COMMAND. THE FORWARD READ IS 00210108
25: C USED TO CHECK ALL OF THE ODD RECORDS AND THE READ REVERSE IN 00220108
26: C EFFECT CHECKS THE EVEN NUMBERED RECORDS. THE ENDFILE COMMAND IS 00230108
27: C ALSO USED AFTER THE WRITE SECTION BUT BECAUSE THE RESULT OF 00240108
28: C ATTEMPTING TO READ OR READ BEYOND THE ENDFILE MARK IS NOT POSSIBLE00250108
29: C TO PREDICT FOR ALL MACHINES, THE ENDFILE MARK IS NEVER ACTUALLY 00260108
30: C READ. 00270108
31: C 00280108
32: C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00290108
33: C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00300108
34: C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00310108
35: C OF THE CONTINUATION LINE. 00320108
36: C 00330108
37: C 00340108
38: C REFERENCES 00350108
39: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00360108
40: C X3.9-1978 00370108
41: C 00380108
42: C SECTION 8, SPECIFICATION STATEMENTS 00390108
43: C SECTION 9, DATA STATEMENT 00400108
44: C SECTION 11.10, DO STATEMENT 00410108
45: C SECTION 12, INPUT/OUTPUT STATEMENTS 00420108
46: C SECTION 12.8.2, INPUT/OUTPUT LIST 00430108
47: C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00440108
48: C SECTION 13, FORMAT STATEMENT 00450108
49: C SECTION 13.2.1, EDIT DESCRIPTORS 00460108
50: C 00470108
51: DIMENSION IDUMP(136) 00480108
52: DIMENSION IADN11(5), IADN12(3), IADN13(3) 00490108
53: CHARACTER*1 NINE,IADN11,ICON04,IDUMP 00500108
54: CHARACTER*2 IADN12,ICON06 00510108
55: CHARACTER*3 IADN13 00520108
56: DATA NINE/'9'/ 00530108
57: DATA IADN11/'-', 'W', 'H', 'E', 'E'/, IADN12/'-H', 'EL', 'L'/, 00540108
58: 1IADN13/'-', 'HE', 'LL'/ 00550108
59: C 00560108
60: 77701 FORMAT ( 80A1 ) 00570108
61: 77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O00580108
62: 1F ,I3,8H RECORDS) 00590108
63: 77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS) 00600108
64: 77704 FORMAT (10X,12HFILE ON LUN ,I2,20H NO EOF.. MORE THAN ,I3,8H RECOR00610108
65: 1DS) 00620108
66: 77705 FORMAT ( 1X,80A1) 00630108
67: 77706 FORMAT (10X,43HFILE I08 CREATED WITH 31 SEQUENTIAL RECORDS) 00640108
68: 77751 FORMAT ( I3,2I2,3I3,I4,4X,I6,4X,F6.2,5X,5A1,4X,I6,4X,F6.4,5X,2A2,A00650108
69: 11 ) 00660108
70: 77752 FORMAT ( I3,2I2,3I3,I4,I6,4X,F6.2,4X,5A1,5X,I6,4X,F6.4,4X,A1,2A2,500670108
71: 1X ) 00680108
72: 77753 FORMAT (7X,I3,6X,I4,4X,I6,15X,A1,8X,I6,4X,F6.4,9X,A1 ) 00690108
73: 77754 FORMAT (7X,I3,6X,I4,I6,14X,A1,9X,I6,4X,F6.4,7X,A2,5X ) 00700108
74: C 00710108
75: C 00720108
76: C ********************************************************** 00730108
77: C 00740108
78: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00750108
79: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00760108
80: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00770108
81: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00780108
82: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00790108
83: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00800108
84: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00810108
85: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00820108
86: C OF EXECUTING THESE TESTS. 00830108
87: C 00840108
88: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00850108
89: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00860108
90: C 00870108
91: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00880108
92: C 00890108
93: C DEPARTMENT OF THE NAVY 00900108
94: C FEDERAL COBOL COMPILER TESTING SERVICE 00910108
95: C WASHINGTON, D.C. 20376 00920108
96: C 00930108
97: C ********************************************************** 00940108
98: C 00950108
99: C 00960108
100: C 00970108
101: C INITIALIZATION SECTION 00980108
102: C 00990108
103: C INITIALIZE CONSTANTS 01000108
104: C ************** 01010108
105: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 01020108
106: I01 = 5 01030108
107: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01040108
108: I02 = 6 01050108
109: C SYSTEM ENVIRONMENT SECTION 01060108
110: C 01070108
111: I01 = 5 01080108
112: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01090108
113: C (UNIT NUMBER FOR CARD READER). 01100108
114: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01110108
115: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01120108
116: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01130108
117: C 01140108
118: I02 = 6 01150108
119: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01160108
120: C (UNIT NUMBER FOR PRINTER). 01170108
121: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01180108
122: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01190108
123: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01200108
124: C 01210108
125: IVPASS=0 01220108
126: IVFAIL=0 01230108
127: IVDELE=0 01240108
128: ICZERO=0 01250108
129: C 01260108
130: C WRITE PAGE HEADERS 01270108
131: WRITE (I02,90000) 01280108
132: WRITE (I02,90001) 01290108
133: WRITE (I02,90002) 01300108
134: WRITE (I02, 90002) 01310108
135: WRITE (I02,90003) 01320108
136: WRITE (I02,90002) 01330108
137: WRITE (I02,90004) 01340108
138: WRITE (I02,90002) 01350108
139: WRITE (I02,90011) 01360108
140: WRITE (I02,90002) 01370108
141: WRITE (I02,90002) 01380108
142: WRITE (I02,90005) 01390108
143: WRITE (I02,90006) 01400108
144: WRITE (I02,90002) 01410108
145: C 01420108
146: C DEFAULT ASSIGNMENT FOR FILE 09 IS I08 = 7 01430108
147: I08 = 7 01440108
148: OPEN(UNIT=I08,ACCESS='SEQUENTIAL',FORM='FORMATTED') 01450108
149: CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081 01460108
150: C 01470108
151: C WRITE SECTION.... 01480108
152: C 01490108
153: C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I08 THAT IS 01500108
154: C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF 01510108
155: C I, F, A, AND X FORMAT. THIS IS THE ONLY FILE TESTED IN THE 01520108
156: C ROUTINE FM108 AND FOR PURPOSES OF IDENTIFICATION IS FILE 09. 01530108
157: C ALL ARRAY ELEMENT DATA FOR THE ALPHANUMERIC CHARACTERS IS SET BY 01540108
158: C THE DATA INITIALIZATION STATEMENT. INTEGER AND REAL VARIABLES ARE 01550108
159: C SET BY ASSIGNMENT STATEMENTS. 01560108
160: C 01570108
161: IPROG = 108 01580108
162: IFILE = 09 01590108
163: ILUN = I08 01600108
164: ITOTR = 31 01610108
165: IRLGN = 80 01620108
166: IEOF = 0000 01630108
167: ICON01 = -32766 01640108
168: RCON01 = -12.34 01650108
169: ICON02 = -12345 01660108
170: RCON02 = -.9999 01670108
171: IFLIP = 1 01680108
172: DO 1254 IRNUM = 1, 31 01690108
173: IF ( IRNUM .EQ. 31 ) IEOF = 9999 01700108
174: IF ( IFLIP - 1 ) 1252, 1252, 1253 01710108
175: 1252 WRITE ( I08, 77751 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF01720108
176: 1, ICON01, RCON01, IADN11,ICON02, RCON02, IADN12 01730108
177: IFLIP = 2 01740108
178: GO TO 1254 01750108
179: 1253 WRITE ( I08, 77752 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF01760108
180: 1, ICON01, RCON01, IADN11, ICON02, RCON02, IADN13 01770108
181: IFLIP = 1 01780108
182: 1254 CONTINUE 01790108
183: WRITE (I02,77706) 01800108
184: C 01810108
185: C ENDFILE SECTION .... 01820108
186: ENDFILE I08 01830108
187: C 01840108
188: C REWIND SECTION 01850108
189: REWIND I08 01860108
190: C 01870108
191: C 01880108
192: C READ FORWARD SECTION .... 01890108
193: C 01900108
194: C 01910108
195: IVTNUM = 125 01920108
196: C 01930108
197: C **** TEST 125 THRU TEST 140 **** 01940108
198: C TEST 125 THRU 140 - THESE TESTS CHECK THE ODD NUMBERED RECORDS. 01950108
199: C THE FILE 09 IS READ SEQUENTIALLY FORWARD AND THE EVEN NUMBERED 01960108
200: C RECORDS ARE SKIPPED BY READING PAST THEM. 01970108
201: C 01980108
202: DO 1255 IRNUM = 1, 31, 2 01990108
203: IVON01 = 0 02000108
204: C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 125-140.02010108
205: READ ( I08,77753 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 02020108
206: C READ AN ODD NUMBERED RECORD.... 02030108
207: IF ( IRNO .EQ. IRNUM ) IVON01 = IVON01 + 1 02040108
208: C IRNO SHOULD BE THE RECORD NUMBER.... 02050108
209: IF ( ICON03 .EQ. ICON01 ) IVON01 = IVON01 + 1 02060108
210: C ICON03 SHOULD EQUAL -32766 .... 02070108
211: IF ( ICON04 .EQ. IADN11(1) ) IVON01 = IVON01 + 1 02080108
212: C ICON04 SHOULD EQUAL '-' .... 02090108
213: IF ( ICON05 .EQ. ICON02 ) IVON01 = IVON01 + 1 02100108
214: C ICON05 SHOULD EQUAL -12345 .... 02110108
215: IF(RCON03.GE. -.99995 .OR. RCON03.LE. -.99985)IVON01=IVON01+1 02120108
216: C RCON03 SHOULD EQUAL -.9999 .... 02130108
217: IF ( ICON06 .EQ. IADN12(3) ) IVON01 = IVON01 + 1 02140108
218: C ICON06 SHOULD EQUAL 'L' .... 02150108
219: IF ( IVON01 - 6 ) 21250, 11250, 21250 02160108
220: 11250 IVPASS = IVPASS + 1 02170108
221: WRITE (I02,80001) IVTNUM 02180108
222: GO TO 1261 02190108
223: 21250 IVFAIL = IVFAIL + 1 02200108
224: IVCOMP = IVON01 02210108
225: IVCORR = 6 02220108
226: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02230108
227: 1261 CONTINUE 02240108
228: IF ( IRNUM .EQ. 31 ) GO TO 1255 02250108
229: C THIS DOES NOT ALLOW READING THE ENDFILE MARK.... 02260108
230: READ ( I08,77754 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 02270108
231: C READ PAST THE EVEN NUMBERED RECORD .... 02280108
232: IVTNUM = IVTNUM + 1 02290108
233: C INCREMENT THE TEST NUMBER.... 02300108
234: 1255 CONTINUE 02310108
235: IF ( ICZERO ) 31250, 1411, 31250 02320108
236: 31250 IVDELE = IVDELE + 1 02330108
237: WRITE (I02,80003) IVTNUM 02340108
238: 1411 CONTINUE 02350108
239: IVTNUM = 141 02360108
240: C 02370108
241: C **** TEST 141 THRU TEST 155 **** 02380108
242: C TEST 141 THRU 155 - THESE TESTS USE THE BACKSPACE COMMAND 02390108
243: C TO READ REVERSE AND CHECK THE EVEN NUMBERED RECORDS. AT THE 02400108
244: C BEGINNING OF THIS SERIES, THE FILE 09 SHOULD BE SETTING AT THE 02410108
245: C ENDFILE MARK PAST RECORD NUMBER 31. 02420108
246: C 02430108
247: BACKSPACE I08 02440108
248: BACKSPACE I08 02450108
249: IRNUM = 30 02460108
250: C THE FILE SHOULD NOW BE SETTING AT RECORD NUMBER 30.... 02470108
251: DO 1552 I = 1, 15 02480108
252: IVON01 = 0 02490108
253: C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 141-155.02500108
254: READ ( I08,77754 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 02510108
255: C READ AN EVEN NUMBERED RECORD.... 02520108
256: IF ( IRNO .EQ. IRNUM ) IVON01 = IVON01 + 1 02530108
257: C IRNO SHOULD BE THE RECORD NUMBER.... 02540108
258: IF ( ICON03 .EQ. ICON01 ) IVON01 = IVON01 + 1 02550108
259: C ICON03 SHOULD EQUAL -32766 .... 02560108
260: IF ( ICON04 .EQ. IADN11(1) ) IVON01 = IVON01 + 1 02570108
261: C ICON04 SHOULD EQUAL '-' .... 02580108
262: IF ( ICON05 .EQ. ICON02 ) IVON01 = IVON01 + 1 02590108
263: C ICON05 SHOULD EQUAL -12345 .... 02600108
264: IF(RCON03.GE. -.99995 .OR. RCON03.LE. -.99985)IVON01=IVON01+1 02610108
265: C RCON03 SHOULD EQUAL -.9999 .... 02620108
266: IF ( ICON06 .EQ. IADN13(3) ) IVON01 = IVON01 + 1 02630108
267: C ICON06 SHOULD EQUAL 'LL' .... 02640108
268: IF ( IVON01 - 6 ) 21410, 11410, 21410 02650108
269: 11410 IVPASS = IVPASS + 1 02660108
270: WRITE (I02,80001) IVTNUM 02670108
271: GO TO 1421 02680108
272: 21410 IVFAIL = IVFAIL + 1 02690108
273: IVCOMP = IVON01 02700108
274: IVCORR = 6 02710108
275: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02720108
276: 1421 CONTINUE 02730108
277: C THIS IS TO NOT ALLOW READING BACKWARDS PAST RECORD NUMBER 1.... 02740108
278: IF ( I .EQ. 15 ) GO TO 1552 02750108
279: C BACKSPACE TO THE NEXT EVEN RECORD.... 02760108
280: BACKSPACE I08 02770108
281: BACKSPACE I08 02780108
282: BACKSPACE I08 02790108
283: IVTNUM = IVTNUM + 1 02800108
284: C INCREMENT THE TEST NUMBER.... 02810108
285: IRNUM = IRNUM - 2 02820108
286: C DECREMENT THE RECORD NUMBER POINTER BY 2 .... 02830108
287: 1552 CONTINUE 02840108
288: IF ( ICZERO ) 31410, 1561, 31410 02850108
289: 31410 IVDELE = IVDELE + 1 02860108
290: WRITE (I02,80003) IVTNUM 02870108
291: 1561 CONTINUE 02880108
292: C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 09 02890108
293: C TO THE LINE PRINTER. 02900108
294: CDB** 02910108
295: C ILUN = I08 02920108
296: C ITOTR = 31 02930108
297: C IRLGN = 80 02940108
298: C7777 REWIND ILUN 02950108
299: C DO 7778 IRNUM = 1, ITOTR 02960108
300: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02970108
301: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02980108
302: C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779 02990108
303: C7778 CONTINUE 03000108
304: C GO TO 7782 03010108
305: C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 03020108
306: C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 03030108
307: C GO TO 7784 03040108
308: C7781 WRITE (I02,77703) ILUN,ITOTR 03050108
309: C GO TO 7784 03060108
310: C7782 WRITE (I02,77704) ILUN, ITOTR 03070108
311: C DO 7783 I = 1, 5 03080108
312: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03090108
313: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03100108
314: C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 03110108
315: C7783 CONTINUE 03120108
316: C7784 GO TO 99999 03130108
317: CDE** 03140108
318: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03150108
319: 99999 CONTINUE 03160108
320: WRITE (I02,90002) 03170108
321: WRITE (I02,90006) 03180108
322: WRITE (I02,90002) 03190108
323: WRITE (I02,90002) 03200108
324: WRITE (I02,90007) 03210108
325: WRITE (I02,90002) 03220108
326: WRITE (I02,90008) IVFAIL 03230108
327: WRITE (I02,90009) IVPASS 03240108
328: WRITE (I02,90010) IVDELE 03250108
329: C 03260108
330: C 03270108
331: C TERMINATE ROUTINE EXECUTION 03280108
332: STOP 03290108
333: C 03300108
334: C FORMAT STATEMENTS FOR PAGE HEADERS 03310108
335: 90000 FORMAT (1H1) 03320108
336: 90002 FORMAT (1H ) 03330108
337: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03340108
338: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 03350108
339: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 03360108
340: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 03370108
341: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 03380108
342: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 03390108
343: C 03400108
344: C FORMAT STATEMENTS FOR RUN SUMMARIES 03410108
345: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 03420108
346: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 03430108
347: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 03440108
348: C 03450108
349: C FORMAT STATEMENTS FOR TEST RESULTS 03460108
350: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 03470108
351: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 03480108
352: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 03490108
353: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 03500108
354: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 03510108
355: C 03520108
356: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM108) 03530108
357: END 03540108
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.