![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM024.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 FM024.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. 00010024
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 00020024
6: C FM024 00030024
7: C 00040024
8: C THREE DIMENSIONED ARRAYS ARE USED IN THIS ROUTINE. 00050024
9: C THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS00060024
10: C SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT. THE VALUES 00070024
11: C OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE 00080024
12: C ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS 00090024
13: C (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO 00100024
14: C INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY 00110024
15: C USE OF THE EQUIVALENCE STATEMENT. 00120024
16: C 00130024
17: C 00140024
18: C REFERENCES 00150024
19: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160024
20: C X3.9-1978 00170024
21: C 00180024
22: C SECTION 8, SPECIFICATION STATEMENTS 00190024
23: C SECTION 8.1, DIMENSION STATEMENT 00200024
24: C SECTION 8.2, EQUIVALENCE STATEMENT 00210024
25: C SECTION 8.3, COMMON STATEMENT 00220024
26: C SECTION 8.4, TYPE-STATEMENTS 00230024
27: C SECTION 9, DATA STATEMENT 00240024
28: C 00250024
29: COMMON ICOE01, RCOE01, LCOE01 00260024
30: COMMON IADE31(3,3,3), RADE31(3,3,3), LADE31(3,3,3) 00270024
31: COMMON IADN31(2,2,2), RADN31(2,2,2), LADN31(2,2,2) 00280024
32: C 00290024
33: DIMENSION IADE32(3,3,3), RADE32(3,3,3), LADE32(3,3,3) 00300024
34: DIMENSION IADN32(2,2,2), IADN21(2,2), IADN11(2) 00310024
35: DIMENSION IADE21(2,2), IADE11(4) 00320024
36: C 00330024
37: EQUIVALENCE (IADE31(1,1,1), IADE32(1,1,1) ) 00340024
38: EQUIVALENCE ( RADE31(1,1,1), RADE32(1,1,1) ) 00350024
39: EQUIVALENCE ( LADE31(1,1,1), LADE32(1,1,1) ) 00360024
40: EQUIVALENCE ( IADE31(1,1,1), IADE21(1,1), IADE11(1) ) 00370024
41: EQUIVALENCE ( ICOE01, ICOE02, ICOE03 ) 00380024
42: C 00390024
43: LOGICAL LADE31, LADN31, LADE32, LCOE01 00400024
44: INTEGER RADN33(2,2,2), RADN21(2,4), RADN11(8) 00410024
45: REAL IADN33(2,2,2), IADN22(2,4), IADN12(8) 00420024
46: C 00430024
47: C 00440024
48: C ********************************************************** 00450024
49: C 00460024
50: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00470024
51: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00480024
52: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00490024
53: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00500024
54: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00510024
55: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00520024
56: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00530024
57: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00540024
58: C OF EXECUTING THESE TESTS. 00550024
59: C 00560024
60: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00570024
61: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00580024
62: C 00590024
63: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00600024
64: C 00610024
65: C DEPARTMENT OF THE NAVY 00620024
66: C FEDERAL COBOL COMPILER TESTING SERVICE 00630024
67: C WASHINGTON, D.C. 20376 00640024
68: C 00650024
69: C ********************************************************** 00660024
70: C 00670024
71: C 00680024
72: C 00690024
73: C INITIALIZATION SECTION 00700024
74: C 00710024
75: C INITIALIZE CONSTANTS 00720024
76: C ************** 00730024
77: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00740024
78: I01 = 5 00750024
79: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00760024
80: I02 = 6 00770024
81: C SYSTEM ENVIRONMENT SECTION 00780024
82: C 00790024
83: I01 = 5 00800024
84: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00810024
85: C (UNIT NUMBER FOR CARD READER). 00820024
86: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00830024
87: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00840024
88: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00850024
89: C 00860024
90: I02 = 6 00870024
91: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00880024
92: C (UNIT NUMBER FOR PRINTER). 00890024
93: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00900024
94: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00910024
95: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00920024
96: C 00930024
97: IVPASS=0 00940024
98: IVFAIL=0 00950024
99: IVDELE=0 00960024
100: ICZERO=0 00970024
101: C 00980024
102: C WRITE PAGE HEADERS 00990024
103: WRITE (I02,90000) 01000024
104: WRITE (I02,90001) 01010024
105: WRITE (I02,90002) 01020024
106: WRITE (I02, 90002) 01030024
107: WRITE (I02,90003) 01040024
108: WRITE (I02,90002) 01050024
109: WRITE (I02,90004) 01060024
110: WRITE (I02,90002) 01070024
111: WRITE (I02,90011) 01080024
112: WRITE (I02,90002) 01090024
113: WRITE (I02,90002) 01100024
114: WRITE (I02,90005) 01110024
115: WRITE (I02,90006) 01120024
116: WRITE (I02,90002) 01130024
117: IVTNUM = 645 01140024
118: C 01150024
119: C **** TEST 645 **** 01160024
120: C TEST 645 - TESTS SETTING A THREE DIMENSION INTEGER ARRAY ELEMENT01170024
121: C BY A SIMPLE INTEGER ASSIGNMENT STATEMENT. 01180024
122: C 01190024
123: IF (ICZERO) 36450, 6450, 36450 01200024
124: 6450 CONTINUE 01210024
125: IADN31(2,2,2) = -9999 01220024
126: IVCOMP = IADN31(2,2,2) 01230024
127: GO TO 46450 01240024
128: 36450 IVDELE = IVDELE + 1 01250024
129: WRITE (I02,80003) IVTNUM 01260024
130: IF (ICZERO) 46450, 6461, 46450 01270024
131: 46450 IF ( IVCOMP + 9999 ) 26450, 16450, 26450 01280024
132: 16450 IVPASS = IVPASS + 1 01290024
133: WRITE (I02,80001) IVTNUM 01300024
134: GO TO 6461 01310024
135: 26450 IVFAIL = IVFAIL + 1 01320024
136: IVCORR = -9999 01330024
137: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01340024
138: 6461 CONTINUE 01350024
139: IVTNUM = 646 01360024
140: C 01370024
141: C **** TEST 646 **** 01380024
142: C TEST 646 - TESTS SETTING A THREE DIMENSION REAL ARRAY ELEMENT 01390024
143: C BY A SIMPLE REAL ASSIGNMENT STATEMENT. 01400024
144: C 01410024
145: IF (ICZERO) 36460, 6460, 36460 01420024
146: 6460 CONTINUE 01430024
147: RADN31(1,2,1) = 512. 01440024
148: IVCOMP = RADN31(1,2,1) 01450024
149: GO TO 46460 01460024
150: 36460 IVDELE = IVDELE + 1 01470024
151: WRITE (I02,80003) IVTNUM 01480024
152: IF (ICZERO) 46460, 6471, 46460 01490024
153: 46460 IF ( IVCOMP - 512 ) 26460, 16460, 26460 01500024
154: 16460 IVPASS = IVPASS + 1 01510024
155: WRITE (I02,80001) IVTNUM 01520024
156: GO TO 6471 01530024
157: 26460 IVFAIL = IVFAIL + 1 01540024
158: IVCORR = 512 01550024
159: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01560024
160: 6471 CONTINUE 01570024
161: IVTNUM = 647 01580024
162: C 01590024
163: C **** TEST 647 **** 01600024
164: C TEST 647 - TESTS SETTING A THREE DIMENSION LOGICAL ARRAY ELEMENT01610024
165: C BY A SIMPLE LOGICAL ASSIGNMENT STATEMENT. 01620024
166: C 01630024
167: IF (ICZERO) 36470, 6470, 36470 01640024
168: 6470 CONTINUE 01650024
169: LADN31(1,2,2) = .TRUE. 01660024
170: ICON01 = 0 01670024
171: IF ( LADN31(1,2,2) ) ICON01 = 1 01680024
172: GO TO 46470 01690024
173: 36470 IVDELE = IVDELE + 1 01700024
174: WRITE (I02,80003) IVTNUM 01710024
175: IF (ICZERO) 46470, 6481, 46470 01720024
176: 46470 IF ( ICON01 - 1 ) 26470, 16470, 26470 01730024
177: 16470 IVPASS = IVPASS + 1 01740024
178: WRITE (I02,80001) IVTNUM 01750024
179: GO TO 6481 01760024
180: 26470 IVFAIL = IVFAIL + 1 01770024
181: IVCOMP = ICON01 01780024
182: IVCORR = 1 01790024
183: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01800024
184: 6481 CONTINUE 01810024
185: IVTNUM = 648 01820024
186: C 01830024
187: C **** TEST 648 **** 01840024
188: C TEST 648 - TESTS SETTING A ONE, TWO, AND THREE DIMENSION ARRAY 01850024
189: C ELEMENT TO A VALUE IN ARITHMETIC ASSIGNMENT STATEMENTS. ALL THREE01860024
190: C ELEMENTS ARE INTEGERS. THE INTEGER ARRAY ELEMENTS ARE THEN USED 01870024
191: C IN AN ARITHMETIC STATEMENT AND THE RESULT IS STORED BY INTEGER 01880024
192: C TO REAL CONVERSION INTO A THREE DIMENSION REAL ARRAY ELEMENT. 01890024
193: C 01900024
194: IF (ICZERO) 36480, 6480, 36480 01910024
195: 6480 CONTINUE 01920024
196: IADN11(2) = 1 01930024
197: IADN21(2,2) = 2 01940024
198: IADN32(2,2,2) = 3 01950024
199: RADN31(2,2,1) = IADN11(2) + IADN21(2,2) + IADN32(2,2,2) 01960024
200: IVCOMP = RADN31(2,2,1) 01970024
201: GO TO 46480 01980024
202: 36480 IVDELE = IVDELE + 1 01990024
203: WRITE (I02,80003) IVTNUM 02000024
204: IF (ICZERO) 46480, 6491, 46480 02010024
205: 46480 IF ( IVCOMP - 6) 26480, 16480, 26480 02020024
206: 16480 IVPASS = IVPASS + 1 02030024
207: WRITE (I02,80001) IVTNUM 02040024
208: GO TO 6491 02050024
209: 26480 IVFAIL = IVFAIL + 1 02060024
210: IVCORR = 6 02070024
211: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02080024
212: 6491 CONTINUE 02090024
213: IVTNUM = 649 02100024
214: C 02110024
215: C **** TEST 649 **** 02120024
216: C TEST 649 - TESTS OF ONE, TWO, AND THREE DIMENSION ARRAY ELEMENTS02130024
217: C SET EXPLICITLY INTEGER BY THE INTEGER TYPE STATEMENT. ALL ELEMENT02140024
218: C VALUES SHOULD BE ZERO FROM REAL TO INTEGER TRUNCATION FROM A VALUE02150024
219: C OF 0.5. ALL THREE ELEMENTS ARE USED IN AN ARITHMETIC EXPRESSION. 02160024
220: C THE VALUE OF THE SUM OF THE ELEMENTS SHOULD BE ZERO. 02170024
221: C 02180024
222: IF (ICZERO) 36490, 6490, 36490 02190024
223: 6490 CONTINUE 02200024
224: RADN11(8) = 0000.50000 02210024
225: RADN21(2,4) = .50000 02220024
226: RADN33(2,2,2) = 00000.5 02230024
227: RADN11(1) = RADN11(8) + RADN21(2,4) + RADN33(2,2,2) 02240024
228: IVCOMP = RADN11(1) 02250024
229: GO TO 46490 02260024
230: 36490 IVDELE = IVDELE + 1 02270024
231: WRITE (I02,80003) IVTNUM 02280024
232: IF (ICZERO) 46490, 6501, 46490 02290024
233: 46490 IF ( IVCOMP - 0 ) 26490, 16490, 26490 02300024
234: 16490 IVPASS = IVPASS + 1 02310024
235: WRITE (I02,80001) IVTNUM 02320024
236: GO TO 6501 02330024
237: 26490 IVFAIL = IVFAIL + 1 02340024
238: IVCORR = 0 02350024
239: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02360024
240: 6501 CONTINUE 02370024
241: IVTNUM = 650 02380024
242: C 02390024
243: C **** TEST 650 **** 02400024
244: C TEST 650 - TEST OF THE EQUIVALENCE STATEMENT. A REAL ARRAY 02410024
245: C ELEMENT IS SET BY AN ASSIGNMENT STATEMENT. ITS EQUIVALENT ELEMENT02420024
246: C IN COMMON IS USED TO SET THE VALUE OF AN INTEGER ARRAY ELEMENT 02430024
247: C ALSO IN COMMON. FINALLY THE DIMENSIONED EQUIVALENT INTEGER 02440024
248: C ARRAY ELEMENT IS TESTED FOR THE VALUE USED THROUGHOUT 32767. 02450024
249: C 02460024
250: IF (ICZERO) 36500, 6500, 36500 02470024
251: 6500 CONTINUE 02480024
252: RADE32(2,2,2) = 32767. 02490024
253: IADE31(2,2,2) = RADE31(2,2,2) 02500024
254: IVCOMP = IADE32(2,2,2) 02510024
255: GO TO 46500 02520024
256: 36500 IVDELE = IVDELE + 1 02530024
257: WRITE (I02,80003) IVTNUM 02540024
258: IF (ICZERO) 46500, 6511, 46500 02550024
259: 46500 IF ( IVCOMP - 32767 ) 26500, 16500, 26500 02560024
260: 16500 IVPASS = IVPASS + 1 02570024
261: WRITE (I02,80001) IVTNUM 02580024
262: GO TO 6511 02590024
263: 26500 IVFAIL = IVFAIL + 1 02600024
264: IVCORR = 32767 02610024
265: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02620024
266: 6511 CONTINUE 02630024
267: IVTNUM = 651 02640024
268: C 02650024
269: C **** TEST 651 **** 02660024
270: C TEST 651 - THIS IS A TEST OF COMMON AND DIMENSION AS WELL AS A 02670024
271: C TEST OF THE EQUIVALENCE STATEMENT USING LOGICAL ARRAY ELEMENTS 02680024
272: C BOTH IN COMMON AND DIMENSIONED. A LOGICAL VARIABLE IN COMMON IS 02690024
273: C SET TO A VALUE OF .NOT. THE VALUE USED IN THE EQUIVALENCED ARRAY 02700024
274: C ELEMENTS WHICH WERE SET IN A LOGICAL ASSIGNMENT STATEMENT. 02710024
275: C 02720024
276: IF (ICZERO) 36510, 6510, 36510 02730024
277: 6510 CONTINUE 02740024
278: LADE31(1,2,3) = .FALSE. 02750024
279: LCOE01 = .NOT. LADE32(1,2,3) 02760024
280: ICON01 = 0 02770024
281: IF ( LCOE01 ) ICON01 = 1 02780024
282: GO TO 46510 02790024
283: 36510 IVDELE = IVDELE + 1 02800024
284: WRITE (I02,80003) IVTNUM 02810024
285: IF (ICZERO) 46510, 6521, 46510 02820024
286: 46510 IF ( ICON01 - 1 ) 26510, 16510, 26510 02830024
287: 16510 IVPASS = IVPASS + 1 02840024
288: WRITE (I02,80001) IVTNUM 02850024
289: GO TO 6521 02860024
290: 26510 IVFAIL = IVFAIL + 1 02870024
291: IVCOMP = ICON01 02880024
292: IVCORR = 1 02890024
293: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02900024
294: 6521 CONTINUE 02910024
295: IVTNUM = 652 02920024
296: C 02930024
297: C **** TEST 652 **** 02940024
298: C TEST 652 - TESTS OF ONE, TWO, AND THREE DIMENSION ARRAY ELEMENTS02950024
299: C SET EXPLICITLY REAL BY THE REAL TYPE STATEMENT. ALL ELEMENT 02960024
300: C VALUES SHOULD BE 0.5 FROM THE REAL ASSIGNMENT STATEMENT. THE 02970024
301: C ARRAY ELEMENTS ARE SUMMED AND THEN THE SUM MULTIPLIED BY 2. 02980024
302: C FINALLY 0.2 IS ADDED TO THE RESULT AND THE FINAL RESULT CONVERTED 02990024
303: C TO AN INTEGER ( ( .5 + .5 + .5 ) * 2. ) + 0.2 03000024
304: C 03010024
305: IF (ICZERO) 36520, 6520, 36520 03020024
306: 6520 CONTINUE 03030024
307: IADN12(5) = 0.5 03040024
308: IADN22(1,3) = 0.5 03050024
309: IADN33(1,2,2) = 0.5 03060024
310: IVCOMP = ( ( IADN12(5) + IADN22(1,3) + IADN33(1,2,2) ) * 2. ) + .203070024
311: GO TO 46520 03080024
312: 36520 IVDELE = IVDELE + 1 03090024
313: WRITE (I02,80003) IVTNUM 03100024
314: IF (ICZERO) 46520, 6531, 46520 03110024
315: 46520 IF ( IVCOMP - 3 ) 26520, 16520, 26520 03120024
316: 16520 IVPASS = IVPASS + 1 03130024
317: WRITE (I02,80001) IVTNUM 03140024
318: GO TO 6531 03150024
319: 26520 IVFAIL = IVFAIL + 1 03160024
320: IVCORR = 3 03170024
321: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03180024
322: 6531 CONTINUE 03190024
323: C 03200024
324: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03210024
325: 99999 CONTINUE 03220024
326: WRITE (I02,90002) 03230024
327: WRITE (I02,90006) 03240024
328: WRITE (I02,90002) 03250024
329: WRITE (I02,90002) 03260024
330: WRITE (I02,90007) 03270024
331: WRITE (I02,90002) 03280024
332: WRITE (I02,90008) IVFAIL 03290024
333: WRITE (I02,90009) IVPASS 03300024
334: WRITE (I02,90010) IVDELE 03310024
335: C 03320024
336: C 03330024
337: C TERMINATE ROUTINE EXECUTION 03340024
338: STOP 03350024
339: C 03360024
340: C FORMAT STATEMENTS FOR PAGE HEADERS 03370024
341: 90000 FORMAT (1H1) 03380024
342: 90002 FORMAT (1H ) 03390024
343: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03400024
344: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 03410024
345: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 03420024
346: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 03430024
347: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 03440024
348: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 03450024
349: C 03460024
350: C FORMAT STATEMENTS FOR RUN SUMMARIES 03470024
351: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 03480024
352: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 03490024
353: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 03500024
354: C 03510024
355: C FORMAT STATEMENTS FOR TEST RESULTS 03520024
356: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 03530024
357: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 03540024
358: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 03550024
359: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 03560024
360: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 03570024
361: C 03580024
362: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM024) 03590024
363: END 03600024
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.