![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM011.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 FM011.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. 00010011
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 00020011
6: C FM011 00030011
7: C 00040011
8: C THIS ROUTINE IS A TEST OF BLANK CHARACTERS (SECTION 3.1.6) 00050011
9: C WHICH SHOULD HAVE NO MEANING WHEN EMBEDDED IN FORTRAN RESERVED00060011
10: C WORDS. 00070011
11: C REFERENCES 00080011
12: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00090011
13: C X3.9-1978 00100011
14: C 00110011
15: C SECTION 3.1.6, BLANK CHARACTER 00120011
16: DIM EN SION IADN11(3),IADN12(3) 00130011
17: IN TEGER RVTNI1 00140011
18: REA L IVTNR1 00150011
19: LOG ICAL LVTNL1,LVTNL2 00160011
20: COM MON IACE11(3) 00170011
21: EQU IVAL ENCE (IACE11(1),IADN11(1)) 00180011
22: D A T A IADN12/3*3/ 00190011
23: C 00200011
24: C ********************************************************** 00210011
25: C 00220011
26: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00230011
27: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00240011
28: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00250011
29: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00260011
30: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00270011
31: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00280011
32: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00290011
33: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00300011
34: C OF EXECUTING THESE TESTS. 00310011
35: C 00320011
36: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00330011
37: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00340011
38: C 00350011
39: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00360011
40: C 00370011
41: C DEPARTMENT OF THE NAVY 00380011
42: C FEDERAL COBOL COMPILER TESTING SERVICE 00390011
43: C WASHINGTON, D.C. 20376 00400011
44: C 00410011
45: C ********************************************************** 00420011
46: C 00430011
47: C 00440011
48: C 00450011
49: C INITIALIZATION SECTION 00460011
50: C 00470011
51: C INITIALIZE CONSTANTS 00480011
52: C ************** 00490011
53: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00500011
54: I01 = 5 00510011
55: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00520011
56: I02 = 6 00530011
57: C SYSTEM ENVIRONMENT SECTION 00540011
58: C 00550011
59: I01 = 5 00560011
60: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00570011
61: C (UNIT NUMBER FOR CARD READER). 00580011
62: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00590011
63: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00600011
64: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00610011
65: C 00620011
66: I02 = 6 00630011
67: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00640011
68: C (UNIT NUMBER FOR PRINTER). 00650011
69: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00660011
70: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670011
71: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00680011
72: C 00690011
73: IVPASS=0 00700011
74: IVFAIL=0 00710011
75: IVDELE=0 00720011
76: ICZERO=0 00730011
77: C 00740011
78: C WRITE PAGE HEADERS 00750011
79: WRITE (I02,90000) 00760011
80: WRITE (I02,90001) 00770011
81: WRITE (I02,90002) 00780011
82: WRITE (I02, 90002) 00790011
83: WRITE (I02,90003) 00800011
84: WRITE (I02,90002) 00810011
85: WRITE (I02,90004) 00820011
86: WRITE (I02,90002) 00830011
87: WRITE (I02,90011) 00840011
88: WRITE (I02,90002) 00850011
89: WRITE (I02,90002) 00860011
90: WRITE (I02,90005) 00870011
91: WRITE (I02,90006) 00880011
92: WRITE (I02,90002) 00890011
93: IVTNUM = 103 00900011
94: C 00910011
95: C **** TEST 103 **** 00920011
96: C TEST 103 - THIS TEST HAS BLANKS EMBEDDED IN A DIMENSION 00930011
97: C STATEMENT. ALSO THE DO STATEMENT WITH AN EMBEDDED BLANK 00940011
98: C WILL BE TESTED TO INITIALIZE VALUES IN AN ARRAY. THE 00950011
99: C CONTINUE AND IF STATEMENTS HAVE EMBEDDED BLANKS AS WELL. 00960011
100: C 00970011
101: IF (ICZERO) 31030, 1030, 31030 00980011
102: 1030 CONTINUE 00990011
103: D O 1 IVON01 =1 , 3 , 1 01000011
104: IADN11(IVON01) = IVON01 01010011
105: 1 C ON T IN UE 01020011
106: GO TO 41030 01030011
107: 31030 IVDELE = IVDELE + 1 01040011
108: WRITE (I02,80003) IVTNUM 01050011
109: IF (ICZERO) 41030, 1041, 41030 01060011
110: 41030 I F (IADN11(2) - 2) 21030,11030,21030 01070011
111: 11030 IVPASS = IVPASS + 1 01080011
112: WRITE (I02,80001) IVTNUM 01090011
113: GO TO 1041 01100011
114: 21030 IVFAIL = IVFAIL + 1 01110011
115: IVCOMP = IADN11(2) 01120011
116: IVCORR = 2 01130011
117: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01140011
118: 1041 CONTINUE 01150011
119: IVTNUM = 104 01160011
120: C 01170011
121: C **** TEST 104 **** 01180011
122: C TEST 104 - THIS TESTS EMBEDDED BLANKS IN AN INTEGER TYPE 01190011
123: C STATEMENT. FRACTION 1/2 SHOULD BECOME 0 AS AN INTEGER. 01200011
124: C INTEGER TO REAL * 2. BACK TO INTEGER CONVERSION SHOULD BE 0.01210011
125: C 01220011
126: IF (ICZERO) 31040, 1040, 31040 01230011
127: 1040 CONTINUE 01240011
128: RVTNI1 = 2 01250011
129: RVON01 = 1/RVTNI1 01260011
130: IVON02 = RVON01 * 2. 01270011
131: GO TO 41040 01280011
132: 31040 IVDELE = IVDELE + 1 01290011
133: WRITE (I02,80003) IVTNUM 01300011
134: IF (ICZERO) 41040, 1051, 41040 01310011
135: 41040 IF( IVON02 - 0 ) 21040,11040,21040 01320011
136: 11040 IVPASS = IVPASS + 1 01330011
137: WRITE (I02,80001) IVTNUM 01340011
138: GO TO 1051 01350011
139: 21040 IVFAIL = IVFAIL + 1 01360011
140: IVCOMP = IVON02 01370011
141: IVCORR = 0 01380011
142: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01390011
143: 1051 CONTINUE 01400011
144: IVTNUM = 105 01410011
145: C 01420011
146: C **** TEST 105 **** 01430011
147: C TEST 105 - TEST OF EMBEDDED BLANKS IN A REAL TYPE STATEMENT. 01440011
148: C REAL TO REAL*2. TO INTEGER CONVERSION IS PERFORMED. RESULT 01450011
149: C IS 1 IF THE TYPE OF THE TEST VARIABLE(IVTNR1) WAS REAL. 01460011
150: C 01470011
151: IF (ICZERO) 31050, 1050, 31050 01480011
152: 1050 CONTINUE 01490011
153: IVTNR1 = .5 01500011
154: RVON03 = IVTNR1*2. 01510011
155: IVON03 = RVON03 +.3 01520011
156: GO TO 41050 01530011
157: 31050 IVDELE = IVDELE + 1 01540011
158: WRITE (I02,80003) IVTNUM 01550011
159: IF (ICZERO) 41050, 1061, 41050 01560011
160: 41050 IF(IVON03 - 1) 21050, 11050, 21050 01570011
161: 11050 IVPASS = IVPASS + 1 01580011
162: WRITE (I02,80001) IVTNUM 01590011
163: GO TO 1061 01600011
164: 21050 IVFAIL = IVFAIL + 1 01610011
165: IVCOMP = IVON03 01620011
166: IVCORR = 1 01630011
167: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01640011
168: 1061 CONTINUE 01650011
169: IVTNUM = 106 01660011
170: C 01670011
171: C **** TEST 106 **** 01680011
172: C TEST 106 - TEST THE LOGICAL TYPE WITH EMBEDDED BLANKS BY A 01690011
173: C LOGIC ASSIGNMENT (V = .TRUE.) SECTION 4.7.1 AND 10.2 01700011
174: C 01710011
175: IF (ICZERO) 31060, 1060, 31060 01720011
176: 1060 CONTINUE 01730011
177: LVTNL1 = .TRUE. 01740011
178: GO TO 41060 01750011
179: 31060 IVDELE = IVDELE + 1 01760011
180: WRITE (I02,80003) IVTNUM 01770011
181: IF (ICZERO) 41060, 1071, 41060 01780011
182: 41060 IF(ICZERO) 21060,11060,21060 01790011
183: 11060 IVPASS = IVPASS + 1 01800011
184: WRITE (I02,80001) IVTNUM 01810011
185: GO TO 1071 01820011
186: 21060 IVFAIL = IVFAIL + 1 01830011
187: WRITE (I02,80002) IVTNUM, IVCOMP ,IVCORR 01840011
188: 1071 CONTINUE 01850011
189: IVTNUM = 107 01860011
190: C 01870011
191: C **** TEST 107 **** 01880011
192: C TEST 107 - A SECOND TEST OF THE LOGICAL TYPE STATEMENT WITH 01890011
193: C EMBEDDED BLANKS. THE TEST IS AGAIN MADE BY A LOGICAL 01900011
194: C ASSIGNMENT (SECTION 4.7.1 AND 10.2). 01910011
195: C 01920011
196: IF (ICZERO) 31070, 1070, 31070 01930011
197: 1070 CONTINUE 01940011
198: LVTNL2 = .FALSE. 01950011
199: GO TO 41070 01960011
200: 31070 IVDELE = IVDELE + 1 01970011
201: WRITE (I02,80003) IVTNUM 01980011
202: IF (ICZERO) 41070, 1081, 41070 01990011
203: 41070 IF(ICZERO) 21070,11070,21070 02000011
204: 11070 IVPASS = IVPASS + 1 02010011
205: WRITE (I02,80001) IVTNUM 02020011
206: GO TO 1081 02030011
207: 21070 IVFAIL = IVFAIL + 1 02040011
208: WRITE (I02,80002) IVTNUM, IVCOMP ,IVCORR 02050011
209: 1081 CONTINUE 02060011
210: IVTNUM = 108 02070011
211: C 02080011
212: C **** TEST 108 **** 02090011
213: C TEST 108 - THIS IS A TEST OF BLANKS EMBEDDED IN THE COMMON, 02100011
214: C DIMENSION AND EQUIVALENCE STATEMENTS (SECTION 8.1, 02110011
215: C 8.3. AND 8.2.). 02120011
216: C 02130011
217: IF (ICZERO) 31080, 1080, 31080 02140011
218: 1080 CONTINUE 02150011
219: IADN11(3) = 4 02160011
220: GO TO 41080 02170011
221: 31080 IVDELE = IVDELE + 1 02180011
222: WRITE (I02,80003) IVTNUM 02190011
223: IF (ICZERO) 41080, 1091, 41080 02200011
224: 41080 IF(IACE11(3) - 4) 21080,11080,21080 02210011
225: 11080 IVPASS = IVPASS + 1 02220011
226: WRITE (I02,80001) IVTNUM 02230011
227: GO TO 1091 02240011
228: 21080 IVFAIL = IVFAIL + 1 02250011
229: IVCOMP = IACE11(3) 02260011
230: IVCORR = 4 02270011
231: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02280011
232: 1091 CONTINUE 02290011
233: IVTNUM = 109 02300011
234: C 02310011
235: C **** TEST 109 **** 02320011
236: C TEST 109 - THIS TESTS THE EFFECT OF BLANKS EMBEDDED IN THE 02330011
237: C DATA STATEMENT BY CHECKING THE INITIALIZATION OF ARRAY 02340011
238: C ELEMENT VALUES (SECTION 9). 02350011
239: C 02360011
240: IF (ICZERO) 31090, 1090, 31090 02370011
241: 1090 CONTINUE 02380011
242: IVON04 = IADN12(1) + IADN12(2) + IADN12(3) 02390011
243: GO TO 41090 02400011
244: 31090 IVDELE = IVDELE + 1 02410011
245: WRITE (I02,80003) IVTNUM 02420011
246: IF (ICZERO) 41090, 1101, 41090 02430011
247: 41090 IF(IVON04 - 9) 21090,11090,21090 02440011
248: 11090 IVPASS = IVPASS + 1 02450011
249: WRITE (I02,80001) IVTNUM 02460011
250: GO TO 1101 02470011
251: 21090 IVFAIL = IVFAIL + 1 02480011
252: IVCOMP = IVON04 02490011
253: IVCORR = 9 02500011
254: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02510011
255: 1101 CONTINUE 02520011
256: C 02530011
257: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02540011
258: 99999 CONTINUE 02550011
259: WRITE (I02,90002) 02560011
260: WRITE (I02,90006) 02570011
261: WRITE (I02,90002) 02580011
262: WRITE (I02,90002) 02590011
263: WRITE (I02,90007) 02600011
264: WRITE (I02,90002) 02610011
265: WRITE (I02,90008) IVFAIL 02620011
266: WRITE (I02,90009) IVPASS 02630011
267: WRITE (I02,90010) IVDELE 02640011
268: C 02650011
269: C 02660011
270: C TERMINATE ROUTINE EXECUTION 02670011
271: STOP 02680011
272: C 02690011
273: C FORMAT STATEMENTS FOR PAGE HEADERS 02700011
274: 90000 FORMAT (1H1) 02710011
275: 90002 FORMAT (1H ) 02720011
276: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02730011
277: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 02740011
278: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 02750011
279: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 02760011
280: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 02770011
281: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 02780011
282: C 02790011
283: C FORMAT STATEMENTS FOR RUN SUMMARIES 02800011
284: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 02810011
285: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 02820011
286: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 02830011
287: C 02840011
288: C FORMAT STATEMENTS FOR TEST RESULTS 02850011
289: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 02860011
290: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 02870011
291: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 02880011
292: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 02890011
293: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 02900011
294: C 02910011
295: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM011) 02920011
296: END 02930011
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.