![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM103.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 FM103.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. 00010103
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 00020103
6: C FM103 00030103
7: C 00040103
8: C THIS ROUTINE IS A TEST OF THE X FORMAT AND IS TAPE AND PRINTER00050103
9: C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060103
10: C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070103
11: C OUTPUT LISTS ARE INTEGER OR REAL VARIABLES, INTEGER ARRAY ELEMENTS00080103
12: C OR ARRAY NAME REFERENCES. READ AND WRITE STATEMENTS ARE DONE 00090103
13: C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100103
14: C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110103
15: C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120103
16: C INTEGER ARRAY FOR THE DUMP SECTION. 00130103
17: C 00140103
18: C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150103
19: C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND 00160103
20: C CHECKED FOR ACCURACY AND THE END OF FILE ON RECORD 31 IS ALSO 00170103
21: C CHECKED. DURING THE READ AND CHECK PROCESS THE FILE IS REWOUND 00180103
22: C TWICE. THE FIRST PASS CHECKS THE ODD NUMBERED RECORDS AND THE 00190103
23: C SECOND PASS CHECKS THE EVEN NUMBERED RECORDS. 00200103
24: C 00210103
25: C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00220103
26: C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00230103
27: C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00240103
28: C OF THE CONTINUATION LINE. 00250103
29: C 00260103
30: C REFERENCES 00270103
31: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00280103
32: C X3.9-1978 00290103
33: C 00300103
34: C SECTION 8, SPECIFICATION STATEMENTS 00310103
35: C SECTION 9, DATA STATEMENT 00320103
36: C SECTION 11.10, DO STATEMENT 00330103
37: C SECTION 12, INPUT/OUTPUT STATEMENTS 00340103
38: C SECTION 12.8.2, INPUT/OUTPUT LIST 00350103
39: C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00360103
40: C SECTION 13, FORMAT STATEMENT 00370103
41: C SECTION 13.2.1, EDIT DESCRIPTORS 00380103
42: C 00390103
43: DIMENSION IDUMP(136) 00400103
44: DIMENSION IADN11(5), IADN12(3), IADN13(3) 00410103
45: CHARACTER*1 NINE,IADN11,ICON04,ICON06,IDUMP 00420103
46: CHARACTER*2 IADN12 00430103
47: CHARACTER*3 IADN13 00440103
48: DATA NINE/'9'/ 00450103
49: DATA IADN11/'A', 'B', 'C', 'D', 'E'/, IADN12 / 'HE', 'LL', 'O'/ 00460103
50: 1,IADN13 / 'H', 'EL', 'LO' / 00470103
51: C 00480103
52: 77701 FORMAT ( 80A1 ) 00490103
53: 77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O00500103
54: 1F ,I3,8H RECORDS) 00510103
55: 77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS) 00520103
56: 77704 FORMAT (10X,12HFILE ON LUN ,I2,20H TOO LONG MORE THAN ,I3,8H RECOR00530103
57: 1DS) 00540103
58: 77705 FORMAT ( 1X,80A1) 00550103
59: 77706 FORMAT (10X,43HFILE I09 CREATED WITH 31 SEQUENTIAL RECORDS) 00560103
60: 77751 FORMAT ( I3,2I2,3I3,I4,5X,I5,5X,F5.2,5X,5A1,5X,I5,5X,F5.4,5X,2A2,A00570103
61: 11 ) 00580103
62: 77752 FORMAT ( I3,2I2,3I3,I4,I5,5X,F5.2,5X,5A1,5X,I5,5X,F5.4,5X,A1,2A2,500590103
63: 1X ) 00600103
64: 77753 FORMAT (7X,I3,6X,I4,5X,I5,15X,A1,9X,I5,5X,F5.4,9X,A1 ) 00610103
65: 77754 FORMAT (7X,I3,6X,I4,I5,15X,A1,9X,I5,5X,F5.4,9X,A1 ) 00620103
66: C 00630103
67: C 00640103
68: C ********************************************************** 00650103
69: C 00660103
70: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00670103
71: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00680103
72: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00690103
73: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00700103
74: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00710103
75: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00720103
76: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00730103
77: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00740103
78: C OF EXECUTING THESE TESTS. 00750103
79: C 00760103
80: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00770103
81: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00780103
82: C 00790103
83: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00800103
84: C 00810103
85: C DEPARTMENT OF THE NAVY 00820103
86: C FEDERAL COBOL COMPILER TESTING SERVICE 00830103
87: C WASHINGTON, D.C. 20376 00840103
88: C 00850103
89: C ********************************************************** 00860103
90: C 00870103
91: C 00880103
92: C 00890103
93: C INITIALIZATION SECTION 00900103
94: C 00910103
95: C INITIALIZE CONSTANTS 00920103
96: C ************** 00930103
97: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00940103
98: I01 = 5 00950103
99: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00960103
100: I02 = 6 00970103
101: C SYSTEM ENVIRONMENT SECTION 00980103
102: C 00990103
103: I01 = 5 01000103
104: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01010103
105: C (UNIT NUMBER FOR CARD READER). 01020103
106: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01030103
107: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01040103
108: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01050103
109: C 01060103
110: I02 = 6 01070103
111: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01080103
112: C (UNIT NUMBER FOR PRINTER). 01090103
113: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01100103
114: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01110103
115: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01120103
116: C 01130103
117: IVPASS=0 01140103
118: IVFAIL=0 01150103
119: IVDELE=0 01160103
120: ICZERO=0 01170103
121: C 01180103
122: C WRITE PAGE HEADERS 01190103
123: WRITE (I02,90000) 01200103
124: WRITE (I02,90001) 01210103
125: WRITE (I02,90002) 01220103
126: WRITE (I02, 90002) 01230103
127: WRITE (I02,90003) 01240103
128: WRITE (I02,90002) 01250103
129: WRITE (I02,90004) 01260103
130: WRITE (I02,90002) 01270103
131: WRITE (I02,90011) 01280103
132: WRITE (I02,90002) 01290103
133: WRITE (I02,90002) 01300103
134: WRITE (I02,90005) 01310103
135: WRITE (I02,90006) 01320103
136: WRITE (I02,90002) 01330103
137: C 01340103
138: C DEFAULT ASSIGNMENT FOR FILE 04 IS I09 = 7 01350103
139: I09 = 7 01360103
140: OPEN(UNIT=I09,ACCESS='SEQUENTIAL',FORM='FORMATTED') 01370103
141: CX091 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-091 01380103
142: C 01390103
143: C WRITE SECTION.... 01400103
144: C 01410103
145: C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I09 THAT IS 01420103
146: C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF 01430103
147: C I, F, A, AND X FORMAT. THIS IS THE ONLY FILE TESTED IN THE 01440103
148: C ROUTINE FM103 AND FOR PURPOSES OF IDENTIFICATION IS FILE 04. 01450103
149: C ALL ARRAY ELEMENT DATA FOR THE ALPHANUMERIC CHARACTERS IS SET BY 01460103
150: C THE DATA INITIALIZATION STATEMENT. INTEGER AND REAL VARIABLES ARE 01470103
151: C SET BY ASSIGNMENT STATEMENTS. 01480103
152: IPROG = 103 01490103
153: IFILE = 04 01500103
154: ILUN = I09 01510103
155: ITOTR = 31 01520103
156: IRLGN = 80 01530103
157: IEOF = 0000 01540103
158: ICON01 = 32767 01550103
159: RCON01 = 12.34 01560103
160: ICON02 = 12345 01570103
161: RCON02 = .9999 01580103
162: IFLIP = 1 01590103
163: DO 504 IRNUM = 1, 31 01600103
164: IF ( IRNUM .EQ. 31 ) IEOF = 9999 01610103
165: IF ( IFLIP - 1 ) 502, 502, 503 01620103
166: 502 WRITE ( I09, 77751 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF01630103
167: 1, ICON01, RCON01, IADN11,ICON02, RCON02, IADN12 01640103
168: IFLIP = 2 01650103
169: GO TO 504 01660103
170: 503 WRITE ( I09, 77752 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF01670103
171: 1, ICON01, RCON01, IADN11, ICON02, RCON02, IADN13 01680103
172: IFLIP = 1 01690103
173: 504 CONTINUE 01700103
174: WRITE (I02,77706) 01710103
175: C 01720103
176: C REWIND SECTION 01730103
177: C 01740103
178: REWIND I09 01750103
179: C 01760103
180: C READ SECTION.... 01770103
181: C 01780103
182: C 01790103
183: IVTNUM = 55 01800103
184: C 01810103
185: C **** TEST 55 THRU 85 **** 01820103
186: C TEST 55 THRU 85 - THESE TESTS CHECK THE RECORD NUMBER AND 01830103
187: C CONTENTS OF SEVERAL OF THE DATA ITEMS WHICH REMAIN CONSTANT FOR 01840103
188: C ALL OF THE RECORDS. A DIFFERENT USE OF THE X SKIP FIELD FORMAT 01850103
189: C IS USED IN READING THE FILE THAN WAS USED TO WRITE THE FILE. 01860103
190: C 01870103
191: IFLIP = 1 01880103
192: DO 556 IRNUM = 1, 31 01890103
193: C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 55 - 85.01900103
194: IVON01 = 0 01910103
195: C READ THE FILE.... 01920103
196: IF ( IFLIP - 1 ) 552, 552, 553 01930103
197: 552 READ ( I09,77753 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 01940103
198: IFLIP = 2 01950103
199: GO TO 554 01960103
200: 553 READ ( I09,77754 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 01970103
201: IFLIP = 1 01980103
202: 554 CONTINUE 01990103
203: IF ( IRNO .EQ. IRNUM ) IVON01 = IVON01 + 1 02000103
204: C IRNO SHOULD BE THE RECORD NUMBER.... 02010103
205: IF ( ICON03 .EQ. ICON01 ) IVON01 = IVON01 + 1 02020103
206: C ICON03 SHOULD EQUAL 32767 .... 02030103
207: IF ( ICON04 .EQ. IADN11(1) ) IVON01 = IVON01 + 1 02040103
208: C ICON04 SHOULD EQUAL 'A' .... 02050103
209: IF ( ICON05 .EQ. ICON02 ) IVON01 = IVON01 + 1 02060103
210: C ICON05 SHOULD EQUAL 12345 .... 02070103
211: IF(RCON03.GE. .99985 .OR. RCON03.LE. .99995) IVON01=IVON01+1 02080103
212: C RCON03 SHOULD EQUAL .9999 .... 02090103
213: IF ( ICON06 .EQ. IADN12(3) ) IVON01 = IVON01 + 1 02100103
214: C ICON06 SHOULD EQUAL 'O' .... 02110103
215: IF ( IVON01 - 6 ) 20550, 10550, 20550 02120103
216: C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE 02130103
217: C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6 02140103
218: C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT.... 02150103
219: 10550 IVPASS = IVPASS + 1 02160103
220: WRITE (I02,80001) IVTNUM 02170103
221: GO TO 555 02180103
222: 20550 IVFAIL = IVFAIL + 1 02190103
223: IVCOMP = IVON01 02200103
224: IVCORR = 6 02210103
225: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02220103
226: 555 CONTINUE 02230103
227: IVTNUM = IVTNUM + 1 02240103
228: C INCREMENT THE TEST NUMBER.... 02250103
229: 556 CONTINUE 02260103
230: IF ( ICZERO ) 30550, 861, 30550 02270103
231: 30550 IVDELE = IVDELE + 1 02280103
232: WRITE (I02,80003) IVTNUM 02290103
233: 861 CONTINUE 02300103
234: IVTNUM = 86 02310103
235: C 02320103
236: C **** TEST 86 **** 02330103
237: C TEST 86 - THIS TEST CHECKS THE END OF FILE INDICATOR ON THE 02340103
238: C 31ST RECORD.. 02350103
239: C 02360103
240: IF (ICZERO) 30860, 860, 30860 02370103
241: 860 CONTINUE 02380103
242: IVCOMP = IEND 02390103
243: GO TO 40860 02400103
244: 30860 IVDELE = IVDELE + 1 02410103
245: WRITE (I02,80003) IVTNUM 02420103
246: IF (ICZERO) 40860, 871, 40860 02430103
247: 40860 IF ( IVCOMP - 9999 ) 20860, 10860, 20860 02440103
248: 10860 IVPASS = IVPASS + 1 02450103
249: WRITE (I02,80001) IVTNUM 02460103
250: GO TO 871 02470103
251: 20860 IVFAIL = IVFAIL + 1 02480103
252: IVCORR = 9999 02490103
253: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02500103
254: 871 CONTINUE 02510103
255: C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 04 02520103
256: C TO THE LINE PRINTER. 02530103
257: CDB** 02540103
258: C ILUN = I09 02550103
259: C ITOTR = 31 02560103
260: C IRLGN = 80 02570103
261: C7777 REWIND ILUN 02580103
262: C DO 7778 IRNUM = 1, ITOTR 02590103
263: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02600103
264: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02610103
265: C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779 02620103
266: C7778 CONTINUE 02630103
267: C GO TO 7782 02640103
268: C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 02650103
269: C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 02660103
270: C GO TO 7784 02670103
271: C7781 WRITE (I02,77703) ILUN,ITOTR 02680103
272: C GO TO 7784 02690103
273: C7782 WRITE (I02,77704) ILUN, ITOTR 02700103
274: C DO 7783 I = 1, 5 02710103
275: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02720103
276: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02730103
277: C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 02740103
278: C7783 CONTINUE 02750103
279: C7784 GO TO 99999 02760103
280: CDE** 02770103
281: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02780103
282: 99999 CONTINUE 02790103
283: WRITE (I02,90002) 02800103
284: WRITE (I02,90006) 02810103
285: WRITE (I02,90002) 02820103
286: WRITE (I02,90002) 02830103
287: WRITE (I02,90007) 02840103
288: WRITE (I02,90002) 02850103
289: WRITE (I02,90008) IVFAIL 02860103
290: WRITE (I02,90009) IVPASS 02870103
291: WRITE (I02,90010) IVDELE 02880103
292: C 02890103
293: C 02900103
294: C TERMINATE ROUTINE EXECUTION 02910103
295: STOP 02920103
296: C 02930103
297: C FORMAT STATEMENTS FOR PAGE HEADERS 02940103
298: 90000 FORMAT (1H1) 02950103
299: 90002 FORMAT (1H ) 02960103
300: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02970103
301: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 02980103
302: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 02990103
303: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 03000103
304: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 03010103
305: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 03020103
306: C 03030103
307: C FORMAT STATEMENTS FOR RUN SUMMARIES 03040103
308: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 03050103
309: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 03060103
310: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 03070103
311: C 03080103
312: C FORMAT STATEMENTS FOR TEST RESULTS 03090103
313: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 03100103
314: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 03110103
315: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 03120103
316: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 03130103
317: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 03140103
318: C 03150103
319: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM103) 03160103
320: END 03170103
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.