![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM302.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 FM302.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 root 1: PROGRAM FM302 00010302
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 00020302
6: C 00030302
7: C THIS ROUTINE TESTS THE SUBSET LEVEL FEATURES OF THE COMMON 00040302
8: C SPECIFICATION STATEMENT. INTEGER, REAL AND LOGICAL VARIABLES AND 00050302
9: C ARRAYS ARE PASSED BACK-AND-FORTH BETWEEN THE MAIN PROGRAM,EXTERNAL00060302
10: C FUNCTIONS AND SUBROUTINES. BOTH NAMED AND UNNAMED (BLANK) COMMON 00070302
11: C ARE TESTED. SPECIFIC TESTS ARE INCLUDED FOR RENAMING ENTITIES IN 00080302
12: C COMMON BETWEEN PROGRAM UNITS, THE PASSING OF DATA THROUGH COMMON 00090302
13: C BY EQUIVALENCE ASSOCIATION, AND THE SPECIFYING OF BLANK COMMON OF 00100302
14: C DIFFERENT LENGTHS IN DIFFERENT PROGRAM UNITS. THE SUBSET LEVEL 00110302
15: C FEATURES OF THE COMMON STATEMENT ARE ALSO TESTED IN FM022 THROUGH 00120302
16: C FM025, FM050 AND FM056. 00130302
17: C 00140302
18: C REFERENCES. 00150302
19: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160302
20: C X3.9-1978 00170302
21: C 00180302
22: C SECTION 8.2, EQUIVALENCE STATEMENT 00190302
23: C SECTION 8.3, COMMON STATEMENT 00200302
24: C SECTION 15.5, EXTERNAL FUNCTIONS 00210302
25: C SECTION 15.6, SUBROUTINES 00220302
26: C SECTION 15.9.4, COMMON BLOCKS 00230302
27: C 00240302
28: C 00250302
29: C ******************************************************************00260302
30: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00270302
31: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00280302
32: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00290302
33: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00300302
34: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00310302
35: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00320302
36: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00330302
37: C THE RESULT OF EXECUTING THESE TESTS. 00340302
38: C 00350302
39: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00360302
40: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00370302
41: C 00380302
42: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00390302
43: C DEPARTMENT OF THE NAVY 00400302
44: C FEDERAL COBOL COMPILER TESTING SERVICE 00410302
45: C WASHINGTON, D.C. 20376 00420302
46: C 00430302
47: C ******************************************************************00440302
48: C 00450302
49: C 00460302
50: IMPLICIT LOGICAL (L) 00470302
51: IMPLICIT CHARACTER*14 (C) 00480302
52: C 00490302
53: 00500302
54: C 00510302
55: C *** SPECIFICATION STATEMENT FOR TEST 001 *** 00520302
56: C 00530302
57: COMMON IVCN01 00540302
58: C 00550302
59: C *** SPECIFICATION STATEMENT FOR TEST 002 *** 00560302
60: C 00570302
61: COMMON //IVCN02,LVCN01 00580302
62: C 00590302
63: C *** SPECIFICATION STATEMENT FOR TEST 003 *** 00600302
64: C 00610302
65: COMMON RVCN01//IVCN03 00620302
66: C 00630302
67: C *** SPECIFICATION STATEMENT FOR TEST 004 *** 00640302
68: C 00650302
69: COMMON IVCN04, IVCN05, // IACN11(4) 00660302
70: C 00670302
71: C *** SPECIFICATION STATEMENT FOR TEST 005 *** 00680302
72: C 00690302
73: COMMON /BLK1/ IVCNA1 00700302
74: C 00710302
75: C *** SPECIFICATION STATEMENT FOR TEST 006 *** 00720302
76: C 00730302
77: COMMON /BLK2/IVCNB1,RVCNB1, /BLK2/IVCNB2 00740302
78: C 00750302
79: C *** SPECIFICATION STATEMENT FOR TEST 007 *** 00760302
80: C 00770302
81: DIMENSION RACN11(10) 00780302
82: COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3) 00790302
83: C 00800302
84: C *** SPECIFICATION STATEMENT FOR TEST 008 *** 00810302
85: C 00820302
86: COMMON /BLK5/IVCND1, IVCND2 00830302
87: C 00840302
88: C *** SPECIFICATION STATEMENT FOR TEST 009 *** 00850302
89: C 00860302
90: COMMON IVCN06/BLK5/RVCND1,LVCND1//IVCN07,IVCN08/BLK6/RVCNE1 00870302
91: C 00880302
92: C *** SPECIFICATION STATEMENT FOR TEST 010 *** 00890302
93: C 00900302
94: DIMENSION IACN1F(3) 00910302
95: COMMON /BLK7/IVCNF1,IVCNF2,IVCNF3,IACN1F 00920302
96: C 00930302
97: C *** SPECIFICATION STATEMENT FOR TEST 011 *** 00940302
98: C 00950302
99: EQUIVALENCE (IVCEH1,IVCEH2) 00960302
100: COMMON /BLK8/IVCEH1 00970302
101: C 00980302
102: C *** SPECIFICATION STATEMENT FOR TEST 012 00990302
103: EQUIVALENCE (IVCE09,IVCE10) 01000302
104: COMMON IVCE09 01010302
105: C 01020302
106: C *** SPECIFICATION STATEMENT FOR TEST 013 01030302
107: C 01040302
108: EQUIVALENCE (IVCEI1,IACE1I) 01050302
109: DIMENSION IACE1I(3) 01060302
110: COMMON /BLK9/IVCEI1 01070302
111: C 01080302
112: C *** SPECIFICATION STATEMENT FOR TEST 014 *** 01090302
113: C 01100302
114: COMMON IVCN12 01110302
115: C 01120302
116: C *** SPECIFICATION STATEMENT FOR TEST 015 *** 01130302
117: C 01140302
118: COMMON /BLK10/IVCNJ1 01150302
119: C 01160302
120: C *** SPECIFICATION STATEMENT FOR TEST 016 *** 01170302
121: C 01180302
122: COMMON /BLKCHR/CVTN01,CVTN02,CATN11 01190302
123: CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5 01200302
124: INTEGER FF304 01210302
125: C 01220302
126: C 01230302
127: C 01240302
128: C INITIALIZATION SECTION. 01250302
129: C 01260302
130: C INITIALIZE CONSTANTS 01270302
131: C ******************** 01280302
132: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01290302
133: I01 = 5 01300302
134: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01310302
135: I02 = 6 01320302
136: C SYSTEM ENVIRONMENT SECTION 01330302
137: C 01340302
138: I01 = 5 01350302
139: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01360302
140: C (UNIT NUMBER FOR CARD READER). 01370302
141: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01380302
142: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01390302
143: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01400302
144: C 01410302
145: I02 = 6 01420302
146: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01430302
147: C (UNIT NUMBER FOR PRINTER). 01440302
148: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01450302
149: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01460302
150: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01470302
151: C 01480302
152: IVPASS = 0 01490302
153: IVFAIL = 0 01500302
154: IVDELE = 0 01510302
155: ICZERO = 0 01520302
156: C 01530302
157: C WRITE OUT PAGE HEADERS 01540302
158: C 01550302
159: WRITE (I02,90002) 01560302
160: WRITE (I02,90006) 01570302
161: WRITE (I02,90008) 01580302
162: WRITE (I02,90004) 01590302
163: WRITE (I02,90010) 01600302
164: WRITE (I02,90004) 01610302
165: WRITE (I02,90016) 01620302
166: WRITE (I02,90001) 01630302
167: WRITE (I02,90004) 01640302
168: WRITE (I02,90012) 01650302
169: WRITE (I02,90014) 01660302
170: WRITE (I02,90004) 01670302
171: C 01680302
172: C 01690302
173: C THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA 01700302
174: C ENTITIES BEING PASSED THROUGH COMMON TO SUBROUTINE FS303. ONLY 01710302
175: C ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM. THE 01720302
176: C CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON ARE 01730302
177: C THEN CHECKED IN THIS PROGRAM. 01740302
178: C 01750302
179: C 01760302
180: IVCN01 = 3 01770302
181: IVCN02 = 2 01780302
182: LVCN01 = .FALSE. 01790302
183: IVCNA1 = 25 01800302
184: IVCNB1 = 3 01810302
185: RVCNB1 = 4.0 01820302
186: IVCNB2 = 5 01830302
187: LVCNC1 = .TRUE. 01840302
188: IVCNC1 = 13 01850302
189: RACN11(1) = 1. 01860302
190: RACN11(10) = 10.0 01870302
191: IACN21(1,1) = 11 01880302
192: IACN21(2,3) = 23 01890302
193: IVCNF1 = 41 01900302
194: IVCNF3 = 43 01910302
195: IACN1F(1) = 141 01920302
196: IACN1F(2) = 142 01930302
197: IVCEH1 = 1 01940302
198: IVCEH2 = 5 01950302
199: CVTN01 = 'AB' 01960302
200: CVTN02 = 'CDE' 01970302
201: CATN11(1) = 'FGHIJ' 01980302
202: CATN11(2) = 'KLMNO' 01990302
203: CATN11(3) = 'PQRST' 02000302
204: CALL FS303 02010302
205: C 02020302
206: C THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA 02030302
207: C ENTITIES BEING PASSED THROUGH COMMON TO EXTERNAL FUNCTION FF304. 02040302
208: C ONLY ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM. 02050302
209: C THE CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON 02060302
210: C ARE THEN CHECKED IN THIS PROGRAM. 02070302
211: C 02080302
212: RVCN01 = 6.4 02090302
213: IVCN03 = 11 02100302
214: IVCN03 = IVCN03*2 02110302
215: IVCN04 = 16 02120302
216: IVCN05 = 16 02130302
217: IACN11(1) = 1 02140302
218: IACN11(2) = 2 02150302
219: IACN11(3) = 3 02160302
220: IACN11(4) = 4 02170302
221: IVCND1 = +33 02180302
222: IVCND2 = 10 02190302
223: IVCN06 = 6 02200302
224: IVCN07 = 7 02210302
225: IVCN08 = 8 02220302
226: RVCND1 = 1.3 02230302
227: LVCND1 = .FALSE. 02240302
228: RVCNE1 = +3.5 02250302
229: IVCE09 = 9 02260302
230: IVCE10 = 10 02270302
231: IVCEI1 = 5 02280302
232: IACE1I(1) = 10 02290302
233: IACE1I(2) = 15 02300302
234: IACE1I(3) = 20 02310302
235: IVCNJ1 = 1 02320302
236: IVON99 = FF304 ( ) 02330302
237: C 02340302
238: C TESTS 001 THROUGH 009 ARE DESIGNED TO TEST VARIOUS 02350302
239: C SYNTACTICAL CONSTRUCTS OF THE COMMON STATEMENT USING NAMED AND 02360302
240: C UNNAMED (BLANK) COMMON IN THE MAIN PROGRAM, A SUBROUTINE AND AN 02370302
241: C EXTERNAL FUNCTION. DATA ENTITIES CONSIST OF INTEGER, REAL AND 02380302
242: C LOGICAL VARIABLES AND INTEGER AND REAL ARRAYS. 02390302
243: C 02400302
244: C **** FCVS PROGRAM 302 - TEST 001 **** 02410302
245: C 02420302
246: C TESTS 001 AND 002 TEST THE USE OF UNNAMED COMMON IN A MAIN 02430302
247: C PROGRAM AND A SUBROUTINE. 02440302
248: C 02450302
249: IVTNUM = 1 02460302
250: IF (ICZERO) 30010, 0010, 30010 02470302
251: 0010 CONTINUE 02480302
252: IVCOMP = 0 02490302
253: IVCOMP = IVCN01 02500302
254: IVCORR = 4 02510302
255: 40010 IF (IVCOMP - 4) 20010, 10010, 20010 02520302
256: 30010 IVDELE = IVDELE + 1 02530302
257: WRITE (I02,80000) IVTNUM 02540302
258: IF (ICZERO) 10010, 0021, 20010 02550302
259: 10010 IVPASS = IVPASS + 1 02560302
260: WRITE (I02,80002) IVTNUM 02570302
261: GO TO 0021 02580302
262: 20010 IVFAIL = IVFAIL + 1 02590302
263: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02600302
264: 0021 CONTINUE 02610302
265: C 02620302
266: C **** FCVS PROGRAM 302 - TEST 002 **** 02630302
267: C 02640302
268: C 02650302
269: IVTNUM = 2 02660302
270: IF (ICZERO) 30020, 0020, 30020 02670302
271: 0020 CONTINUE 02680302
272: IVCOMP = 1 02690302
273: IF (IVCN02 .EQ. 7) IVCOMP = IVCOMP * 2 02700302
274: IF (LVCN01) IVCOMP = IVCOMP * 3 02710302
275: IVCORR = 6 02720302
276: C 6 = 2 * 3 02730302
277: 40020 IF (IVCOMP - 6) 20020, 10020, 20020 02740302
278: 30020 IVDELE = IVDELE + 1 02750302
279: WRITE (I02,80000) IVTNUM 02760302
280: IF (ICZERO) 10020, 0031, 20020 02770302
281: 10020 IVPASS = IVPASS + 1 02780302
282: WRITE (I02,80002) IVTNUM 02790302
283: GO TO 0031 02800302
284: 20020 IVFAIL = IVFAIL + 1 02810302
285: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02820302
286: 0031 CONTINUE 02830302
287: C 02840302
288: C **** FCVS PROGRAM 302 - TEST 003 **** 02850302
289: C 02860302
290: C TESTS 003 AND 004 TEST THE USE OF UNNAMED COMMON IN A MAIN 02870302
291: C PROGRAM AND AN EXTERNAL FUNCTION. 02880302
292: C 02890302
293: IVTNUM = 3 02900302
294: IF (ICZERO) 30030, 0030, 30030 02910302
295: 0030 CONTINUE 02920302
296: IVCOMP = 1 02930302
297: IF (RVCN01 .GE. 4.1995 .AND. RVCN01 .LE. 4.2005) IVCOMP=IVCOMP*2 02940302
298: IF (IVCN03 .EQ. 23) IVCOMP = IVCOMP * 3 02950302
299: IVCORR = 6 02960302
300: C 6 = 2 * 3 02970302
301: 40030 IF (IVCOMP - 6) 20030, 10030, 20030 02980302
302: 30030 IVDELE = IVDELE + 1 02990302
303: WRITE (I02,80000) IVTNUM 03000302
304: IF (ICZERO) 10030, 0041, 20030 03010302
305: 10030 IVPASS = IVPASS + 1 03020302
306: WRITE (I02,80002) IVTNUM 03030302
307: GO TO 0041 03040302
308: 20030 IVFAIL = IVFAIL + 1 03050302
309: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03060302
310: 0041 CONTINUE 03070302
311: C 03080302
312: C **** FCVS PROGRAM 302 - TEST 004 **** 03090302
313: C 03100302
314: C 03110302
315: IVTNUM = 4 03120302
316: IF (ICZERO) 30040, 0040, 30040 03130302
317: 0040 CONTINUE 03140302
318: IVCOMP = 1 03150302
319: IF (IVCN04 .EQ. 8) IVCOMP = IVCOMP * 2 03160302
320: IF (IVCN05 .EQ. 16) IVCOMP = IVCOMP * 3 03170302
321: IF (IACN11(1) .EQ. 5) IVCOMP = IVCOMP * 5 03180302
322: IF (IACN11(2) .EQ. 5) IVCOMP = IVCOMP * 7 03190302
323: IF (IACN11(3) .EQ. 5) IVCOMP = IVCOMP * 11 03200302
324: IF (IACN11(4) .EQ. 5) IVCOMP = IVCOMP * 13 03210302
325: IVCORR = 30030 03220302
326: C 30030 = 2 * 3 * 5 * 7 * 11 * 13 03230302
327: 40040 IF (IVCOMP - 30030) 20040, 10040, 20040 03240302
328: 30040 IVDELE = IVDELE + 1 03250302
329: WRITE (I02,80000) IVTNUM 03260302
330: IF (ICZERO) 10040, 0051, 20040 03270302
331: 10040 IVPASS = IVPASS + 1 03280302
332: WRITE (I02,80002) IVTNUM 03290302
333: GO TO 0051 03300302
334: 20040 IVFAIL = IVFAIL + 1 03310302
335: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03320302
336: 0051 CONTINUE 03330302
337: C 03340302
338: C **** FCVS PROGRAM 302 - TEST 005 **** 03350302
339: C 03360302
340: C TESTS 005 THROUGH 007 TEST THE USE OF NAMED COMMON BLOCKS 03370302
341: C IN A MAIN PROGRAM AND A SUBROUTINE. 03380302
342: C 03390302
343: IVTNUM = 5 03400302
344: IF (ICZERO) 30050, 0050, 30050 03410302
345: 0050 CONTINUE 03420302
346: IVCOMP = 0 03430302
347: IVCOMP = IVCNA1 03440302
348: IVCORR = 5 03450302
349: 40050 IF (IVCOMP - 5) 20050, 10050, 20050 03460302
350: 30050 IVDELE = IVDELE + 1 03470302
351: WRITE (I02,80000) IVTNUM 03480302
352: IF (ICZERO) 10050, 0061, 20050 03490302
353: 10050 IVPASS = IVPASS + 1 03500302
354: WRITE (I02,80002) IVTNUM 03510302
355: GO TO 0061 03520302
356: 20050 IVFAIL = IVFAIL + 1 03530302
357: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03540302
358: 0061 CONTINUE 03550302
359: C 03560302
360: C **** FCVS PROGRAM 302 - TEST 006 **** 03570302
361: C 03580302
362: C 03590302
363: IVTNUM = 6 03600302
364: IF (ICZERO) 30060, 0060, 30060 03610302
365: 0060 CONTINUE 03620302
366: IVCOMP = 1 03630302
367: IF (IVCNB1 .EQ. 8) IVCOMP = IVCOMP * 2 03640302
368: IF (RVCNB1 .GE. 3.4995 .AND. RVCNB1 .LE. 3.5005) IVCOMP=IVCOMP*3 03650302
369: IF (IVCNB2 .EQ. 5) IVCOMP = IVCOMP * 5 03660302
370: IVCORR = 30 03670302
371: C 30 = 2 * 3 * 5 03680302
372: 40060 IF (IVCOMP - 30) 20060, 10060, 20060 03690302
373: 30060 IVDELE = IVDELE + 1 03700302
374: WRITE (I02,80000) IVTNUM 03710302
375: IF (ICZERO) 10060, 0071, 20060 03720302
376: 10060 IVPASS = IVPASS + 1 03730302
377: WRITE (I02,80002) IVTNUM 03740302
378: GO TO 0071 03750302
379: 20060 IVFAIL = IVFAIL + 1 03760302
380: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03770302
381: 0071 CONTINUE 03780302
382: C 03790302
383: C **** FCVS PROGRAM 302 - TEST 007 **** 03800302
384: C 03810302
385: C 03820302
386: IVTNUM = 7 03830302
387: IF (ICZERO) 30070, 0070, 30070 03840302
388: 0070 CONTINUE 03850302
389: IVCOMP = 1 03860302
390: IF (.NOT. LVCNC1) IVCOMP = IVCOMP * 2 03870302
391: IF (IVCNC1 .EQ. 12) IVCOMP = IVCOMP * 3 03880302
392: IF (RACN11(1).GE.110.95 .AND. RACN11(1).LE.111.05) IVCOMP=IVCOMP*503890302
393: IF (RACN11(10).GE.109.95.AND.RACN11(10).LE.110.05)IVCOMP=IVCOMP*7 03900302
394: IF (IACN21(1,1) .EQ. 12) IVCOMP = IVCOMP * 11 03910302
395: IF (IACN21 (2,3) .EQ. 24) IVCOMP = IVCOMP * 13 03920302
396: IVCORR = 30030 03930302
397: C 30030 = 2* 3 * 5 * 7 * 11 * 13 03940302
398: 40070 IF (IVCOMP - 30030) 20070, 10070, 20070 03950302
399: 30070 IVDELE = IVDELE + 1 03960302
400: WRITE (I02,80000) IVTNUM 03970302
401: IF (ICZERO) 10070, 0081, 20070 03980302
402: 10070 IVPASS = IVPASS + 1 03990302
403: WRITE (I02,80002) IVTNUM 04000302
404: GO TO 0081 04010302
405: 20070 IVFAIL = IVFAIL + 1 04020302
406: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04030302
407: 0081 CONTINUE 04040302
408: C 04050302
409: C **** FCVS PROGRAM 302 - TEST 008 **** 04060302
410: C 04070302
411: C TESTS 008 AND 009 TEST THE USE OF NAMED COMMON BLOCKS IN A 04080302
412: C MAIN PROGRAM AND AN EXTERNAL FUNCTION. 04090302
413: C 04100302
414: IVTNUM = 8 04110302
415: IF (ICZERO) 30080, 0080, 30080 04120302
416: 0080 CONTINUE 04130302
417: IVCOMP = 1 04140302
418: IF (IVCND1 .EQ. 34) IVCOMP = IVCOMP * 2 04150302
419: IF (IVCND2 .EQ. 11) IVCOMP = IVCOMP * 3 04160302
420: IVCORR = 6 04170302
421: C 6 = 2 * 3 04180302
422: 40080 IF (IVCOMP - 6) 20080, 10080, 20080 04190302
423: 30080 IVDELE = IVDELE + 1 04200302
424: WRITE (I02,80000) IVTNUM 04210302
425: IF (ICZERO) 10080, 0091, 20080 04220302
426: 10080 IVPASS = IVPASS + 1 04230302
427: WRITE (I02,80002) IVTNUM 04240302
428: GO TO 0091 04250302
429: 20080 IVFAIL = IVFAIL + 1 04260302
430: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04270302
431: 0091 CONTINUE 04280302
432: C 04290302
433: C **** FCVS PROGRAM 302 - TEST 009 **** 04300302
434: C 04310302
435: C 04320302
436: IVTNUM = 9 04330302
437: IF (ICZERO) 30090, 0090, 30090 04340302
438: 0090 CONTINUE 04350302
439: IVCOMP = 1 04360302
440: IF (IVCN06 .EQ. 7) IVCOMP = IVCOMP * 2 04370302
441: IF (RVCND1 .GE. 4.4995 .AND. RVCND1 .LE. 4.5005) IVCOMP = IVCOMP*304380302
442: IF (LVCND1) IVCOMP = IVCOMP * 5 04390302
443: IF (IVCN07 .EQ. -7) IVCOMP = IVCOMP * 7 04400302
444: IF (IVCN08 .EQ. -3) IVCOMP = IVCOMP * 11 04410302
445: IF (RVCNE1.GE.-6.7005.AND.RVCNE1.LE.-6.6995) IVCOMP=IVCOMP*13 04420302
446: IVCORR = 30030 04430302
447: C 30030 = 2 * 3 * 5 * 7 * 11 * 13 04440302
448: 40090 IF (IVCOMP - 30030) 20090, 10090, 20090 04450302
449: 30090 IVDELE = IVDELE + 1 04460302
450: WRITE (I02,80000) IVTNUM 04470302
451: IF (ICZERO) 10090, 0101, 20090 04480302
452: 10090 IVPASS = IVPASS + 1 04490302
453: WRITE (I02,80002) IVTNUM 04500302
454: GO TO 0101 04510302
455: 20090 IVFAIL = IVFAIL + 1 04520302
456: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04530302
457: 0101 CONTINUE 04540302
458: C 04550302
459: C **** FCVS PROGRAM 302 - TEST 010 **** 04560302
460: C 04570302
461: C TEST 010 IS DESIGNED TO TEST THE ABILITY TO RENAME ENTITIES 04580302
462: C IN NAMED COMMON BETWEEN A MAIN PROGRAM AND A SUBROUTINE. 04590302
463: C 04600302
464: IVTNUM = 10 04610302
465: IF (ICZERO) 30100, 0100, 30100 04620302
466: 0100 CONTINUE 04630302
467: IVCOMP = 1 04640302
468: IF (IVCNF1 .EQ. 42) IVCOMP = IVCOMP * 2 04650302
469: IF (IVCNF2 .EQ. 43) IVCOMP = IVCOMP * 3 04660302
470: IF (IVCNF3 .EQ. 44) IVCOMP = IVCOMP * 5 04670302
471: IF (IACN1F(1) .EQ. 142) IVCOMP = IVCOMP * 7 04680302
472: IF (IACN1F(2) .EQ. 143) IVCOMP = IVCOMP * 11 04690302
473: IF (IACN1F(3) .EQ. 144) IVCOMP = IVCOMP * 13 04700302
474: IVCORR = 30030 04710302
475: C 30030 = 2 * 3 * 5 * 7 * 11 * 13 04720302
476: 40100 IF (IVCOMP - 30030) 20100, 10100, 20100 04730302
477: 30100 IVDELE = IVDELE + 1 04740302
478: WRITE (I02,80000) IVTNUM 04750302
479: IF (ICZERO) 10100, 0111, 20100 04760302
480: 10100 IVPASS = IVPASS + 1 04770302
481: WRITE (I02,80002) IVTNUM 04780302
482: GO TO 0111 04790302
483: 20100 IVFAIL = IVFAIL + 1 04800302
484: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04810302
485: 0111 CONTINUE 04820302
486: C 04830302
487: C **** FCVS PROGRAM 302 - TEST 011 **** 04840302
488: C 04850302
489: C TEST 011 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE IN 04860302
490: C NAMED COMMON BY EQUIVALENCE ASSOCIATION. 04870302
491: C 04880302
492: IVTNUM = 11 04890302
493: IF (ICZERO) 30110, 0110, 30110 04900302
494: 0110 CONTINUE 04910302
495: IVCOMP = 0 04920302
496: IVCOMP = IVCEH2 04930302
497: IVCORR = 6 04940302
498: 40110 IF (IVCOMP - 6) 20110, 10110, 20110 04950302
499: 30110 IVDELE = IVDELE + 1 04960302
500: WRITE (I02,80000) IVTNUM 04970302
501: IF (ICZERO) 10110, 0121, 20110 04980302
502: 10110 IVPASS = IVPASS + 1 04990302
503: WRITE (I02,80002) IVTNUM 05000302
504: GO TO 0121 05010302
505: 20110 IVFAIL = IVFAIL + 1 05020302
506: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05030302
507: 0121 CONTINUE 05040302
508: C 05050302
509: C **** FCVS PROGRAM 302 - TEST 012 **** 05060302
510: C 05070302
511: C TEST 012 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE IN 05080302
512: C UNNAMED COMMON BY EQUIVALENCE ASSOCIATION. 05090302
513: C 05100302
514: IVTNUM = 12 05110302
515: IF (ICZERO) 30120, 0120, 30120 05120302
516: 0120 CONTINUE 05130302
517: IVCOMP = 1 05140302
518: IF (IVCE09 .EQ. 100) IVCOMP = IVCOMP * 2 05150302
519: IF (IVCE10 .EQ. 100) IVCOMP = IVCOMP * 3 05160302
520: IVCORR = 6 05170302
521: C 6 = 2 * 3 05180302
522: 40120 IF (IVCOMP - 6) 20120, 10120, 20120 05190302
523: 30120 IVDELE = IVDELE + 1 05200302
524: WRITE (I02,80000) IVTNUM 05210302
525: IF (ICZERO) 10120, 0131, 20120 05220302
526: 10120 IVPASS = IVPASS + 1 05230302
527: WRITE (I02,80002) IVTNUM 05240302
528: GO TO 0131 05250302
529: 20120 IVFAIL = IVFAIL + 1 05260302
530: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05270302
531: 0131 CONTINUE 05280302
532: C 05290302
533: C **** FCVS PROGRAM 302 - TEST 013 **** 05300302
534: C 05310302
535: C TEST 013 IS DESIGNED TO TEST THE EXTENSION OF NAMED COMMON 05320302
536: C BLOCK STORAGE BY EQUIVALENCE ASSOCIATION OF A VARIABLE AND AN 05330302
537: C ARRAY. 05340302
538: C 05350302
539: IVTNUM = 13 05360302
540: IF (ICZERO) 30130, 0130, 30130 05370302
541: 0130 CONTINUE 05380302
542: IVCOMP = 1 05390302
543: IF (IVCEI1 .EQ. 11) IVCOMP = IVCOMP * 2 05400302
544: IF (IACE1I(1) .EQ. 11) IVCOMP = IVCOMP * 3 05410302
545: IF (IACE1I(2) .EQ. 16) IVCOMP = IVCOMP * 5 05420302
546: IF (IACE1I(3) .EQ. 21) IVCOMP = IVCOMP * 7 05430302
547: IVCORR = 210 05440302
548: C 210 = 2 * 3 * 5 * 7 05450302
549: 40130 IF (IVCOMP - 210) 20130, 10130, 20130 05460302
550: 30130 IVDELE = IVDELE + 1 05470302
551: WRITE (I02,80000) IVTNUM 05480302
552: IF (ICZERO) 10130, 0141, 20130 05490302
553: 10130 IVPASS = IVPASS + 1 05500302
554: WRITE (I02,80002) IVTNUM 05510302
555: GO TO 0141 05520302
556: 20130 IVFAIL = IVFAIL + 1 05530302
557: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05540302
558: 0141 CONTINUE 05550302
559: C 05560302
560: C **** FCVS PROGRAM 302 - TEST 014 **** 05570302
561: C 05580302
562: C TEST 014 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA 05590302
563: C THROUGH UNNAMED COMMON FROM EXTERNAL FUNCTIONS WHICH HAVE MORE 05600302
564: C ENTITIES IN UNNAMED COMMON THAN THE MAIN PROGRAM. 05610302
565: C 05620302
566: IVTNUM = 14 05630302
567: IF (ICZERO) 30140, 0140, 30140 05640302
568: 0140 CONTINUE 05650302
569: IVCOMP = 0 05660302
570: IVCOMP = IVCN12 05670302
571: IVCORR = 11 05680302
572: 40140 IF (IVCOMP - 11) 20140, 10140, 20140 05690302
573: 30140 IVDELE = IVDELE + 1 05700302
574: WRITE (I02,80000) IVTNUM 05710302
575: IF (ICZERO) 10140, 0151, 20140 05720302
576: 10140 IVPASS = IVPASS + 1 05730302
577: WRITE (I02,80002) IVTNUM 05740302
578: GO TO 0151 05750302
579: 20140 IVFAIL = IVFAIL + 1 05760302
580: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05770302
581: 0151 CONTINUE 05780302
582: C 05790302
583: C **** FCVS PROGRAM 302 - TEST 015 **** 05800302
584: C 05810302
585: C TEST 015 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA 05820302
586: C THROUGH NAMED COMMON BETWEEN EXTERNAL FUNCTIONS WHERE THE NAMED 05830302
587: C COMMON BLOCK IS NOT SPECIFIED IN THE MAIN PROGRAM. 05840302
588: C 05850302
589: IVTNUM = 15 05860302
590: IF (ICZERO) 30150, 0150, 30150 05870302
591: 0150 CONTINUE 05880302
592: IVCOMP = 0 05890302
593: IVCOMP = IVCNJ1 05900302
594: IVCORR = 5 05910302
595: 40150 IF (IVCOMP - 5) 20150, 10150, 20150 05920302
596: 30150 IVDELE = IVDELE + 1 05930302
597: WRITE (I02,80000) IVTNUM 05940302
598: IF (ICZERO) 10150, 0161, 20150 05950302
599: 10150 IVPASS = IVPASS + 1 05960302
600: WRITE (I02,80002) IVTNUM 05970302
601: GO TO 0161 05980302
602: 20150 IVFAIL = IVFAIL + 1 05990302
603: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06000302
604: 0161 CONTINUE 06010302
605: C 06020302
606: C **** FCVS PROGRAM 302 - TEST 016 **** 06030302
607: C 06040302
608: C TEST 016 IS DESIGNED TO TEST THE PASSING OF CHARACTER DATA 06050302
609: C IN NAMED COMMON BETWEEN THE MAIN PROGRAM AND A SUBROUTINE. 06060302
610: C 06070302
611: IVTNUM = 16 06080302
612: IF (ICZERO) 30160, 0160, 30160 06090302
613: 0160 CONTINUE 06100302
614: IVCOMP = 1 06110302
615: IF (CVTN01 .EQ. 'YZ') IVCOMP = IVCOMP * 2 06120302
616: IF (CVTN02 .EQ. 'UVW') IVCOMP = IVCOMP * 3 06130302
617: IF (CATN11(1) .EQ. 'VWXYZ') IVCOMP = IVCOMP * 5 06140302
618: IF (CATN11(2) .EQ. 'KLMNO') IVCOMP = IVCOMP * 7 06150302
619: IF (CATN11(3) .EQ. 'ABCDE') IVCOMP = IVCOMP * 11 06160302
620: IVCORR = 2310 06170302
621: C 2310 = 2 * 3 * 5 * 7 * 11 06180302
622: 40160 IF (IVCOMP - 2310) 20160, 10160, 20160 06190302
623: 30160 IVDELE = IVDELE + 1 06200302
624: WRITE (I02,80000) IVTNUM 06210302
625: IF (ICZERO) 10160, 0171, 20160 06220302
626: 10160 IVPASS = IVPASS + 1 06230302
627: WRITE (I02,80002) IVTNUM 06240302
628: GO TO 0171 06250302
629: 20160 IVFAIL = IVFAIL + 1 06260302
630: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06270302
631: 0171 CONTINUE 06280302
632: C 06290302
633: C 06300302
634: C WRITE OUT TEST SUMMARY 06310302
635: C 06320302
636: WRITE (I02,90004) 06330302
637: WRITE (I02,90014) 06340302
638: WRITE (I02,90004) 06350302
639: WRITE (I02,90000) 06360302
640: WRITE (I02,90004) 06370302
641: WRITE (I02,90020) IVFAIL 06380302
642: WRITE (I02,90022) IVPASS 06390302
643: WRITE (I02,90024) IVDELE 06400302
644: STOP 06410302
645: 90001 FORMAT (1H ,24X,5HFM302) 06420302
646: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM302) 06430302
647: C 06440302
648: C FORMATS FOR TEST DETAIL LINES 06450302
649: C 06460302
650: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 06470302
651: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 06480302
652: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 06490302
653: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 06500302
654: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 06510302
655: C 06520302
656: C FORMAT STATEMENTS FOR PAGE HEADERS 06530302
657: C 06540302
658: 90002 FORMAT (1H1) 06550302
659: 90004 FORMAT (1H ) 06560302
660: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 06570302
661: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 06580302
662: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 06590302
663: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 06600302
664: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 06610302
665: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 06620302
666: C 06630302
667: C FORMAT STATEMENTS FOR RUN SUMMARY 06640302
668: C 06650302
669: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 06660302
670: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 06670302
671: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 06680302
672: END 06690302
673: SUBROUTINE FS303 00010303
674: C DATE***82/08/02*18.33.46
675: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
676: C AUDIT FCVS78 V2.0
677: C 00020303
678: C FS303 IS A SUBROUTINE WHICH IS CALLED ONCE FROM PROGRAM FM302. 00030303
679: C IT IS USED TO MODIFY VARIABLES AND ARRAY PASSED THROUGH NAMED AND 00040303
680: C UNNAMED COMMON FROM FM302. AFTER THE DATA ENTITIES ARE MODIFIED 00050303
681: C CONTROL IS RETURNED TO FM302 WHERE EACH ENTITY IS TESTED. 00060303
682: C 00070303
683: IMPLICIT LOGICAL (L) 00080303
684: DIMENSION RACN11(10) 00090303
685: COMMON IVCN01 00100303
686: COMMON //IVCN02, LVCN01 00110303
687: COMMON RVCN01//IVCN03 00120303
688: COMMON IVCN04,IVCN05, //IACN11(4) 00130303
689: COMMON /BLK1/IVCNA1 00140303
690: COMMON /BLK2/IVCNB1,RVCNB1,/BLK2/IVCNB2 00150303
691: COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3) 00160303
692: COMMON /BLK7/IACN1G(5),IVCNG1 00170303
693: COMMON /BLK8/IVCNH1 00180303
694: COMMON /BLKCHR/CVTN01,CVTN02,CATN11 00190303
695: CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5 00200303
696: C TEST 001 00210303
697: IVCN01 = IVCN01 + 1 00220303
698: C TEST 002 00230303
699: IVCN02 = IVCN02 + 5 00240303
700: LVCN01 = .NOT. LVCN01 00250303
701: C TEST 005 00260303
702: IVCNA1 = IVCNA1 / 5 00270303
703: C TEST 006 00280303
704: IVCNB1 = IVCNB1 + IVCNB2 00290303
705: RVCNB1 = 3.5 00300303
706: C TEST 007 00310303
707: LVCNC1 = .FALSE. 00320303
708: IVCNC1 = IVCNC1 - 1 00330303
709: RACN11(1) = 111. 00340303
710: RACN11(10) = 110. 00350303
711: IACN21(1,1) = IACN21(1,1) + 1 00360303
712: IACN21(2,3) = IACN21(2,3) + 1 00370303
713: C TEST 010 00380303
714: IACN1G(1) = IACN1G(1) + 1 00390303
715: IACN1G(2) = 43 00400303
716: IACN1G(3) = IACN1G(3) + 1 00410303
717: IACN1G(4) = IACN1G(4) + 1 00420303
718: IACN1G(5) = IACN1G(5) + 1 00430303
719: IVCNG1 = 144 00440303
720: C TEST 011 00450303
721: IVCNH1 = IVCNH1 + 1 00460303
722: C TEST 017 00470303
723: CVTN01 = 'YZ' 00480303
724: CVTN02 = 'UVW' 00490303
725: CATN11(1) = 'VWXYZ' 00500303
726: CATN11(3) = 'ABCDE' 00510303
727: RETURN 00520303
728: END 00530303
729: INTEGER FUNCTION FF304 () 00010304
730: C DATE***82/08/02*18.33.46
731: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
732: C AUDIT FCVS78 V2.0
733: C 00020304
734: C FF304 IS AN EXTERNAL FUNCTION WHICH IS REFERENCED ONCE FROM 00030304
735: C PROGRAM FM302. IT IS USED TO MODIFY VARIABLES AND ARRAYS PASSED 00040304
736: C THROUGH NAMED AND UNNAMED COMMON FROM FM302. AFTER THE DATA 00050304
737: C ENTITIES ARE MODIFIED CONTROL IS RETURNED TO FM302 WHERE EACH 00060304
738: C ENTITY IS TESTED. A FUNCTION VALUE OF 999 IS RETURNED BUT IT IS 00070304
739: C NOT SIGNIFICANT NOR IS IT TESTED BY FM302. 00080304
740: C 00090304
741: IMPLICIT LOGICAL (L) 00100304
742: DIMENSION IACN11(4) 00110304
743: COMMON IVCN01 00120304
744: COMMON IVCN02, LVCN01 00130304
745: COMMON RVCN01, IVCN03 00140304
746: COMMON IVCN04,IVCN05,IACN11 00150304
747: COMMON /BLK5/IVCND1,IVCND2 00160304
748: COMMON IVCN06 00170304
749: COMMON /BLK5/RVCND1,LVCND1 00180304
750: COMMON IVCN07, IVCN08 00190304
751: COMMON /BLK6/RVCNE1 00200304
752: COMMON IVCN10 00210304
753: COMMON /BLK9/IVCNI1, IVCNI2, IVCNI3 00220304
754: COMMON IVCN12, IVCN13 00230304
755: COMMON /BLK10/IVCNJ1 00240304
756: COMMON /BLK11/IVCNK1 00250304
757: INTEGER FF305 00260304
758: C TEST 003 00270304
759: RVCN01 = 4.2 00280304
760: IVCN03 = IVCN03 + 1 00290304
761: C TEST 004 00300304
762: IVCN04 = 32 00310304
763: IVCN04 = IVCN04 / 4 00320304
764: IVCN05 = IVCN05 00330304
765: IACN11(1) = IACN11(1) + 4 00340304
766: IACN11(2) = IACN11(2) + 3 00350304
767: IACN11(3) = IACN11(3) + 2 00360304
768: IACN11(4) = IACN11(4) + 1 00370304
769: C TEST 008 00380304
770: IVCND1 = IVCND1 + 1 00390304
771: IVCND2 = IVCND2 + 1 00400304
772: C TEST 009 00410304
773: IVCN06 = IVCN06 + 1 00420304
774: RVCND1 = 4.5 00430304
775: LVCND1 = .TRUE. 00440304
776: IVCN07 = -IVCN07 00450304
777: IVCN08 = -3 00460304
778: RVCNE1 = -6.7 00470304
779: C TEST 012 00480304
780: IVCN10 = IVCN10 * IVCN10 00490304
781: C TEST 013 00500304
782: IVCNI1 = IVCNI1 + 1 00510304
783: IVCNI2 = IVCNI2 + 1 00520304
784: IVCNI3 = IVCNI3 + 1 00530304
785: C TEST 014 00540304
786: IVCN13 = 5 00550304
787: C TEST 015 00560304
788: IVCNK1 = 3 00570304
789: C 00580304
790: C FOR TESTS 014 AND 015 EXTERNAL FUNCTION FF305 IS REFERENCED 00590304
791: C 00600304
792: IVON99 = FF305 () 00610304
793: C TEST 014 00620304
794: IVCN12 = IVCN13 00630304
795: C TEST 015 00640304
796: IVCNJ1 = IVCNK1 00650304
797: FF304 = 999 00660304
798: RETURN 00670304
799: END 00680304
800: INTEGER FUNCTION FF305 () 00010305
801: C DATE***82/08/02*18.33.46
802: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
803: C AUDIT FCVS78 V2.0
804: C 00020305
805: C FF305 IS AN EXTERNAL FUNCTION WHICH IS USED IN TEST 014 AND 00030305
806: C 015 OF PROGRAM FM302. THIS SUBPROGRAM IS REFERENCED FROM EXTERNAL 00040305
807: C FUNCTION FF304. 00050305
808: C 00060305
809: COMMON IACN11(15) 00070305
810: COMMON IVCN12, IVCN13, IVCN14 00080305
811: COMMON /BLK10/IVCNJ1, /BLK11/IVCNK1 00090305
812: C TEST 014 00100305
813: IVCN14 = 11 00110305
814: IVCN13 = IVCN14 00120305
815: C TEST 015 00130305
816: IVCNK1 = 5 00140305
817: FF305 = 999 00150305
818: RETURN 00160305
819: END 00170305
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.