![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM301.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 FM301.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 FM301 00010301
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 00020301
6: C 00030301
7: C FM301 TESTS THE USE OF THE TYPE-STATEMENT TO EXPLICITLY 00040301
8: C DEFINE THE DATA TYPE FOR VARIABLES, ARRAYS, AND STATEMENT 00050301
9: C FUNCTIONS. ONLY INTEGER, REAL, LOGICAL AND CHARACTER DATA 00060301
10: C TYPES ARE TESTED IN THIS ROUTINE. INTEGER AND REAL VARIABLES 00070301
11: C AND ARRAYS ARE TESTED IN A MANNER WHICH BOTH CONFIRMS AND 00080301
12: C OVERRIDES THE IMPLICIT TYPING OF THE DATA ENTITIES. 00090301
13: C 00100301
14: C FM301 DOES NOT ATTEMPT TO TEST ALL OF THE ELEMENTARY SYNTAX 00110301
15: C FORMS OF THE TYPE-STATEMENT. THESE FORMS ARE TESTED ADEQUATELY 00120301
16: C WITHIN THE BOILER PLATE AND OTHER AUDIT PROGRAMS. 00130301
17: C 00140301
18: C REFERENCES. 00150301
19: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160301
20: C X3.9-1978 00170301
21: C 00180301
22: C SECTION 4.1, DATA TYPES 00190301
23: C SECTION 8.4, TYPE-STATEMENT 00200301
24: C SECTION 8.5, IMPLICIT STATEMENT 00210301
25: C SECTION 15.4, STATEMENT FUNCTION 00220301
26: C 00230301
27: C 00240301
28: C ******************************************************************00250301
29: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00260301
30: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00270301
31: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00280301
32: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00290301
33: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00300301
34: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00310301
35: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00320301
36: C THE RESULT OF EXECUTING THESE TESTS. 00330301
37: C 00340301
38: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00350301
39: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00360301
40: C 00370301
41: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00380301
42: C DEPARTMENT OF THE NAVY 00390301
43: C FEDERAL COBOL COMPILER TESTING SERVICE 00400301
44: C WASHINGTON, D.C. 20376 00410301
45: C 00420301
46: C ******************************************************************00430301
47: C 00440301
48: C 00450301
49: IMPLICIT LOGICAL (L) 00460301
50: IMPLICIT CHARACTER*14 (C) 00470301
51: C 00480301
52: 00490301
53: C 00500301
54: C *** IMPLICIT STATEMENT FOR TEST 006 *** 00510301
55: C 00520301
56: IMPLICIT LOGICAL (M) 00530301
57: C 00540301
58: C *** IMPLICIT STATEMENT FOR TEST 017 *** 00550301
59: C 00560301
60: IMPLICIT INTEGER (G) 00570301
61: C 00580301
62: C *** IMPLICIT STATEMENT FOR TEST 018 *** 00590301
63: C 00600301
64: IMPLICIT CHARACTER*2 (F) 00610301
65: C 00620301
66: C *** SPECIFICATION STATEMENTS FOR TEST 001 *** 00630301
67: C 00640301
68: INTEGER AVTN01 00650301
69: C 00660301
70: C *** SPECIFICATION STATEMENTS FOR TEST 002 *** 00670301
71: C 00680301
72: REAL KVTN01 00690301
73: C 00700301
74: C *** SPECIFICATION STATEMENTS FOR TEST 003 *** 00710301
75: C 00720301
76: INTEGER KVTN02, AVTN02, KVTN03 00730301
77: C 00740301
78: C *** SPECIFICATION STATEMENTS FOR TEST 004 *** 00750301
79: C 00760301
80: REAL AVTN03, AVTN04, KVTN04 00770301
81: C 00780301
82: C *** SPECIFICATION STATEMENTS FOR TEST 005 *** 00790301
83: C 00800301
84: LOGICAL HVTN01 00810301
85: C 00820301
86: C *** SPECIFICATION STATEMENTS FOR TEST 006 *** 00830301
87: C (ALSO SEE THE IMPLICIT STATEMENTS FOR TEST 006) 00840301
88: C 00850301
89: REAL MVTN01 00860301
90: C 00870301
91: C *** SPECIFICATION STATEMENTS FOR TEST 007 *** 00880301
92: C 00890301
93: INTEGER NVTN11(4) 00900301
94: C 00910301
95: C *** SPECIFICATION STATEMENTS FOR TEST 008 *** 00920301
96: C 00930301
97: REAL NVTN22(2,2) 00940301
98: C 00950301
99: C *** SPECIFICATION STATEMENTS FOR TESTS 009 AND 010 *** 00960301
100: C 00970301
101: INTEGER NVTN33(3,3,3), AVTN15(5) 00980301
102: C 00990301
103: C *** SPECIFICATION STATEMENTS FOR TEST 011 *** 01000301
104: C 01010301
105: DIMENSION NVTN14(5) 01020301
106: INTEGER NVTN14 01030301
107: C 01040301
108: C *** SPECIFICATION STATEMENTS FOR TEST 012 *** 01050301
109: C 01060301
110: DIMENSION AVTN16(4) 01070301
111: INTEGER AVTN16 01080301
112: C 01090301
113: C *** SPECIFICATION STATEMENTS FOR TESTS 013 AND 014 *** 01100301
114: C 01110301
115: CHARACTER CVTN01*14, CATN12(4)*14 01120301
116: C 01130301
117: C *** SPECIFICATION STATEMENTS FOR TEST 015 *** 01140301
118: C 01150301
119: DIMENSION CADN13(6) 01160301
120: CHARACTER CADN13*14 01170301
121: C 01180301
122: C *** SPECIFICATION STATEMENTS FOR TEST 016 *** 01190301
123: C 01200301
124: CHARACTER KVTN05 01210301
125: C 01220301
126: C *** SPECIFICATION STATEMENTS FOR TEST 017 *** 01230301
127: C (ALSO SEE THE IMPLICIT STATEMENT FOR TEST 017) 01240301
128: C 01250301
129: CHARACTER GVTN01*3 01260301
130: C 01270301
131: C *** SPECIFICATION STATEMENTS FOR TEST 018 *** 01280301
132: C (ALSO SEE THE IMPLICIT STATEMENT FOR TEST 018) 01290301
133: C 01300301
134: CHARACTER FVTN01*3 01310301
135: C 01320301
136: C *** SPECIFICATION STATEMENTS FOR TEST 019 *** 01330301
137: C 01340301
138: INTEGER IFTN01 01350301
139: IFTN01(IDON01) = IDON01 + 1 01360301
140: C 01370301
141: C 01380301
142: C 01390301
143: C INITIALIZATION SECTION. 01400301
144: C 01410301
145: C INITIALIZE CONSTANTS 01420301
146: C ******************** 01430301
147: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01440301
148: I01 = 5 01450301
149: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01460301
150: I02 = 6 01470301
151: C SYSTEM ENVIRONMENT SECTION 01480301
152: C 01490301
153: I01 = 5 01500301
154: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01510301
155: C (UNIT NUMBER FOR CARD READER). 01520301
156: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01530301
157: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01540301
158: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01550301
159: C 01560301
160: I02 = 6 01570301
161: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01580301
162: C (UNIT NUMBER FOR PRINTER). 01590301
163: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01600301
164: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01610301
165: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01620301
166: C 01630301
167: IVPASS = 0 01640301
168: IVFAIL = 0 01650301
169: IVDELE = 0 01660301
170: ICZERO = 0 01670301
171: C 01680301
172: C WRITE OUT PAGE HEADERS 01690301
173: C 01700301
174: WRITE (I02,90002) 01710301
175: WRITE (I02,90006) 01720301
176: WRITE (I02,90008) 01730301
177: WRITE (I02,90004) 01740301
178: WRITE (I02,90010) 01750301
179: WRITE (I02,90004) 01760301
180: WRITE (I02,90016) 01770301
181: WRITE (I02,90001) 01780301
182: WRITE (I02,90004) 01790301
183: WRITE (I02,90012) 01800301
184: WRITE (I02,90014) 01810301
185: WRITE (I02,90004) 01820301
186: C 01830301
187: C 01840301
188: C **** FCVS PROGRAM 301 - TEST 001 **** 01850301
189: C 01860301
190: C TEST 001 DEFINES AN INTEGER VARIABLE OVERRIDING THE IMPLICIT 01870301
191: C COMPILER DEFAULT TYPE SPECIFYING REAL. 01880301
192: C 01890301
193: C 01900301
194: IVTNUM = 1 01910301
195: IF (ICZERO) 30010, 0010, 30010 01920301
196: 0010 CONTINUE 01930301
197: IVCOMP = 0 01940301
198: AVTN01 = 100 01950301
199: IVCORR = 100 01960301
200: IVCOMP = AVTN01 01970301
201: 40010 IF (IVCOMP - 100) 20010, 10010, 20010 01980301
202: 30010 IVDELE = IVDELE + 1 01990301
203: WRITE (I02,80000) IVTNUM 02000301
204: IF (ICZERO) 10010, 0021, 20010 02010301
205: 10010 IVPASS = IVPASS + 1 02020301
206: WRITE (I02,80002) IVTNUM 02030301
207: GO TO 0021 02040301
208: 20010 IVFAIL = IVFAIL + 1 02050301
209: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02060301
210: 0021 CONTINUE 02070301
211: C 02080301
212: C **** FCVS PROGRAM 301 - TEST 002 **** 02090301
213: C 02100301
214: C TEST 002 DEFINES A REAL VARIABLE OVERRIDING THE IMPLICIT 02110301
215: C COMPILER DEFAULT TYPE SPECIFYING INTEGER. 02120301
216: C 02130301
217: C 02140301
218: IVTNUM = 2 02150301
219: IF (ICZERO) 30020, 0020, 30020 02160301
220: 0020 CONTINUE 02170301
221: RVCOMP = 0.0 02180301
222: KVTN01 = 1.004 02190301
223: RVCORR = 1.004 02200301
224: RVCOMP = KVTN01 02210301
225: 40020 IF (RVCOMP - 1.0035) 20020, 10020, 40021 02220301
226: 40021 IF (RVCOMP - 1.0045) 10020, 10020, 20020 02230301
227: 30020 IVDELE = IVDELE + 1 02240301
228: WRITE (I02,80000) IVTNUM 02250301
229: IF (ICZERO) 10020, 0031, 20020 02260301
230: 10020 IVPASS = IVPASS + 1 02270301
231: WRITE (I02,80002) IVTNUM 02280301
232: GO TO 0031 02290301
233: 20020 IVFAIL = IVFAIL + 1 02300301
234: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02310301
235: 0031 CONTINUE 02320301
236: C 02330301
237: C **** FCVS PROGRAM 301 - TEST 003 **** 02340301
238: C 02350301
239: C TEST 003 DEFINES A SERIES OF INTEGER VARIABLES IN ONE TYPE- 02360301
240: C STATEMENT. TWO VARIABLES CONFIRM THE IMPLICIT INTEGER TYPING. 02370301
241: C THE OTHER VARIABLE OVERRIDES THE IMPLICIT TYPING. 02380301
242: C 02390301
243: C 02400301
244: IVTNUM = 3 02410301
245: IF (ICZERO) 30030, 0030, 30030 02420301
246: 0030 CONTINUE 02430301
247: IVCOMP = 0 02440301
248: KVTN02 = 20 02450301
249: KVTN03 = 30 02460301
250: AVTN02 = 200 02470301
251: IVCORR = 20 02480301
252: IVCOMP = KVTN02 02490301
253: 40030 IF (IVCOMP - 20) 20030, 40031, 20030 02500301
254: 40031 IVCORR = 30 02510301
255: IVCOMP = KVTN03 02520301
256: 40033 IF (IVCOMP - 30) 20030, 40034, 20030 02530301
257: 40034 IVCORR = 200 02540301
258: IVCOMP = AVTN02 02550301
259: 40035 IF (IVCOMP - 200) 20030, 10030, 20030 02560301
260: 30030 IVDELE = IVDELE + 1 02570301
261: WRITE (I02,80000) IVTNUM 02580301
262: IF (ICZERO) 10030, 0041, 20030 02590301
263: 10030 IVPASS = IVPASS + 1 02600301
264: WRITE (I02,80002) IVTNUM 02610301
265: GO TO 0041 02620301
266: 20030 IVFAIL = IVFAIL + 1 02630301
267: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02640301
268: 0041 CONTINUE 02650301
269: C 02660301
270: C **** FCVS PROGRAM 301 - TEST 004 **** 02670301
271: C 02680301
272: C TEST 004 DEFINES A SERIES OF REAL VARIABLES IN ONE TYPE- 02690301
273: C STATEMENT. TWO VARIABLES CONFIRM THE IMPLICIT REAL TYPING. THE 02700301
274: C THIRD VARIABLE OVERRIDES THE IMPLICIT TYPING. 02710301
275: C 02720301
276: C 02730301
277: IVTNUM = 4 02740301
278: IF (ICZERO) 30040, 0040, 30040 02750301
279: 0040 CONTINUE 02760301
280: RVCOMP = 0.0 02770301
281: AVTN03 = 3.0 02780301
282: AVTN04 = 4. 02790301
283: KVTN04 = .4 02800301
284: RVCORR = 3.0 02810301
285: RVCOMP = AVTN03 02820301
286: 40040 IF (RVCOMP - 2.9995) 20040, 40042, 40041 02830301
287: 40041 IF (RVCOMP - 3.0005) 40042, 40042, 20040 02840301
288: 40042 RVCORR = 4. 02850301
289: RVCOMP = AVTN04 02860301
290: 40043 IF (RVCOMP - 3.9995) 20040, 40045, 40044 02870301
291: 40044 IF (RVCOMP - 4.0005) 40045, 40045, 20040 02880301
292: 40045 RVCORR = .4 02890301
293: RVCOMP = KVTN04 02900301
294: 40046 IF (RVCOMP - .39995) 20040, 10040, 40047 02910301
295: 40047 IF (RVCOMP - .40005) 10040, 10040, 20040 02920301
296: 30040 IVDELE = IVDELE + 1 02930301
297: WRITE (I02,80000) IVTNUM 02940301
298: IF (ICZERO) 10040, 0051, 20040 02950301
299: 10040 IVPASS = IVPASS + 1 02960301
300: WRITE (I02,80002) IVTNUM 02970301
301: GO TO 0051 02980301
302: 20040 IVFAIL = IVFAIL + 1 02990301
303: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03000301
304: 0051 CONTINUE 03010301
305: C 03020301
306: C **** FCVS PROGRAM 301 - TEST 005 **** 03030301
307: C 03040301
308: C TEST 005 DEFINES A LOGICAL VARIABLE. 03050301
309: C 03060301
310: C 03070301
311: IVTNUM = 5 03080301
312: IF (ICZERO) 30050, 0050, 30050 03090301
313: 0050 CONTINUE 03100301
314: HVTN01 = .TRUE. 03110301
315: IVCORR = 1 03120301
316: IVCOMP = 0 03130301
317: IF (HVTN01) IVCOMP = 1 03140301
318: 40050 IF (IVCOMP - 1) 20050, 10050, 20050 03150301
319: 30050 IVDELE = IVDELE + 1 03160301
320: WRITE (I02,80000) IVTNUM 03170301
321: IF (ICZERO) 10050, 0061, 20050 03180301
322: 10050 IVPASS = IVPASS + 1 03190301
323: WRITE (I02,80002) IVTNUM 03200301
324: GO TO 0061 03210301
325: 20050 IVFAIL = IVFAIL + 1 03220301
326: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03230301
327: 0061 CONTINUE 03240301
328: C 03250301
329: C **** FCVS PROGRAM 301 - TEST 006 **** 03260301
330: C 03270301
331: C TEST 006 DEFINES A REAL VARIABLE WITH A TYPE-STATEMENT THAT 03280301
332: C OVERRIDES THE IMPLICIT STATEMENT TYPING OF THE INTEGER LETTER 'M' 03290301
333: C AS LOGICAL. 03300301
334: C 03310301
335: C 03320301
336: IVTNUM = 6 03330301
337: IF (ICZERO) 30060, 0060, 30060 03340301
338: 0060 CONTINUE 03350301
339: RVCOMP = 0.0 03360301
340: MVTN01 = 12.345 03370301
341: RVCORR = 12.345 03380301
342: RVCOMP = MVTN01 03390301
343: 40060 IF (RVCOMP - 12.340) 20060, 10060, 40061 03400301
344: 40061 IF (RVCOMP - 12.350) 10060, 10060, 20060 03410301
345: 30060 IVDELE = IVDELE + 1 03420301
346: WRITE (I02,80000) IVTNUM 03430301
347: IF (ICZERO) 10060, 0071, 20060 03440301
348: 10060 IVPASS = IVPASS + 1 03450301
349: WRITE (I02,80002) IVTNUM 03460301
350: GO TO 0071 03470301
351: 20060 IVFAIL = IVFAIL + 1 03480301
352: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03490301
353: 0071 CONTINUE 03500301
354: C 03510301
355: C **** FCVS PROGRAM 301 - TEST 007 **** 03520301
356: C 03530301
357: C TEST 007 DEFINES A ONE DIMENSIONAL INTEGER ARRAY. 03540301
358: C 03550301
359: C 03560301
360: IVTNUM = 7 03570301
361: IF (ICZERO) 30070, 0070, 30070 03580301
362: 0070 CONTINUE 03590301
363: IVCOMP = 0 03600301
364: NVTN11(3) = 3 03610301
365: IVCORR = 3 03620301
366: IVCOMP = NVTN11(3) 03630301
367: 40070 IF (IVCOMP - 3) 20070, 10070, 20070 03640301
368: 30070 IVDELE = IVDELE + 1 03650301
369: WRITE (I02,80000) IVTNUM 03660301
370: IF (ICZERO) 10070, 0081, 20070 03670301
371: 10070 IVPASS = IVPASS + 1 03680301
372: WRITE (I02,80002) IVTNUM 03690301
373: GO TO 0081 03700301
374: 20070 IVFAIL = IVFAIL + 1 03710301
375: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03720301
376: 0081 CONTINUE 03730301
377: C 03740301
378: C **** FCVS PROGRAM 301 - TEST 008 **** 03750301
379: C 03760301
380: C TEST 008 DEFINES A TWO DIMENSIONAL REAL ARRAY THAT OVERRIDES 03770301
381: C THE IMPLICIT TYPING OF INTEGER. 03780301
382: C 03790301
383: C 03800301
384: IVTNUM = 8 03810301
385: IF (ICZERO) 30080, 0080, 30080 03820301
386: 0080 CONTINUE 03830301
387: RVCOMP = 0.0 03840301
388: NVTN22(1,2) = 2.12 03850301
389: RVCORR = 2.12 03860301
390: RVCOMP = NVTN22(1,2) 03870301
391: 40080 IF (RVCOMP - 2.1195) 20080, 10080, 40081 03880301
392: 40081 IF (RVCOMP - 2.1205) 10080, 10080, 20080 03890301
393: 30080 IVDELE = IVDELE + 1 03900301
394: WRITE (I02,80000) IVTNUM 03910301
395: IF (ICZERO) 10080, 0091, 20080 03920301
396: 10080 IVPASS = IVPASS + 1 03930301
397: WRITE (I02,80002) IVTNUM 03940301
398: GO TO 0091 03950301
399: 20080 IVFAIL = IVFAIL + 1 03960301
400: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03970301
401: 0091 CONTINUE 03980301
402: C 03990301
403: C **** FCVS PROGRAM 301 - TEST 009 **** 04000301
404: C 04010301
405: C TEST 009 DEFINES TWO INTEGER ARRAYS WITH ONE TYPE-STATEMENT. 04020301
406: C ONE ARRAY IS THREE DIMENSIONAL WHILE THE OTHER ARRAY OVERRIDES 04030301
407: C THE IMPLICIT TYPING OF REAL. ONLY THE THREE DIMENSIONAL ARRAY 04040301
408: C IS CHECKED IN THIS TEST. 04050301
409: C 04060301
410: C 04070301
411: IVTNUM = 9 04080301
412: IF (ICZERO) 30090, 0090, 30090 04090301
413: 0090 CONTINUE 04100301
414: IVCOMP = 0 04110301
415: NVTN33(1,2,3) = 123 04120301
416: IVCORR = 123 04130301
417: IVCOMP = NVTN33(1,2,3) 04140301
418: 40090 IF (IVCOMP - 123) 20090, 10090, 20090 04150301
419: 30090 IVDELE = IVDELE + 1 04160301
420: WRITE (I02,80000) IVTNUM 04170301
421: IF (ICZERO) 10090, 0101, 20090 04180301
422: 10090 IVPASS = IVPASS + 1 04190301
423: WRITE (I02,80002) IVTNUM 04200301
424: GO TO 0101 04210301
425: 20090 IVFAIL = IVFAIL + 1 04220301
426: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04230301
427: 0101 CONTINUE 04240301
428: C 04250301
429: C **** FCVS PROGRAM 301 - TEST 010 **** 04260301
430: C 04270301
431: C TEST 010 CHECKS THE SECOND ARRAY DESCRIBED IN THE PREVIOUS 04280301
432: C TEST. 04290301
433: C 04300301
434: C 04310301
435: IVTNUM = 10 04320301
436: IF (ICZERO) 30100, 0100, 30100 04330301
437: 0100 CONTINUE 04340301
438: IVCOMP = 0 04350301
439: AVTN15(2) = 5 04360301
440: IVCORR = 5 04370301
441: IVCOMP = AVTN15(2) 04380301
442: 40100 IF (IVCOMP - 5) 20100, 10100, 20100 04390301
443: 30100 IVDELE = IVDELE + 1 04400301
444: WRITE (I02,80000) IVTNUM 04410301
445: IF (ICZERO) 10100, 0111, 20100 04420301
446: 10100 IVPASS = IVPASS + 1 04430301
447: WRITE (I02,80002) IVTNUM 04440301
448: GO TO 0111 04450301
449: 20100 IVFAIL = IVFAIL + 1 04460301
450: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04470301
451: 0111 CONTINUE 04480301
452: C 04490301
453: C **** FCVS PROGRAM 301 - TEST 011 **** 04500301
454: C 04510301
455: C TEST 011 USES THE TYPE-STATEMENT TO EXPLICITLY TYPE AN ARRAY 04520301
456: C THAT WAS DEFINED WITH A DIMENSION STATEMENT. 04530301
457: C 04540301
458: C 04550301
459: IVTNUM = 11 04560301
460: IF (ICZERO) 30110, 0110, 30110 04570301
461: 0110 CONTINUE 04580301
462: IVCOMP = 0 04590301
463: NVTN14(5) = 5 04600301
464: IVCORR = 5 04610301
465: IVCOMP = NVTN14(5) 04620301
466: 40110 IF (IVCOMP - 5) 20110, 10110, 20110 04630301
467: 30110 IVDELE = IVDELE + 1 04640301
468: WRITE (I02,80000) IVTNUM 04650301
469: IF (ICZERO) 10110, 0121, 20110 04660301
470: 10110 IVPASS = IVPASS + 1 04670301
471: WRITE (I02,80002) IVTNUM 04680301
472: GO TO 0121 04690301
473: 20110 IVFAIL = IVFAIL + 1 04700301
474: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04710301
475: 0121 CONTINUE 04720301
476: C 04730301
477: C **** FCVS PROGRAM 301 - TEST 012 **** 04740301
478: C 04750301
479: C TEST 012 USES THE TYPE-STATEMENT TO OVERRIDE THE TYPING OF 04760301
480: C AN ARRAY THAT WAS DEFINED WITH A DIMENSION STATEMENT. 04770301
481: C 04780301
482: IVTNUM = 12 04790301
483: IF (ICZERO) 30120, 0120, 30120 04800301
484: 0120 CONTINUE 04810301
485: IVCOMP = 0 04820301
486: AVTN16(3) = 163 04830301
487: IVCORR = 163 04840301
488: IVCOMP = AVTN16(3) 04850301
489: 40120 IF (IVCOMP - 163) 20120, 10120, 20120 04860301
490: 30120 IVDELE = IVDELE + 1 04870301
491: WRITE (I02,80000) IVTNUM 04880301
492: IF (ICZERO) 10120, 0131, 20120 04890301
493: 10120 IVPASS = IVPASS + 1 04900301
494: WRITE (I02,80002) IVTNUM 04910301
495: GO TO 0131 04920301
496: 20120 IVFAIL = IVFAIL + 1 04930301
497: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04940301
498: 0131 CONTINUE 04950301
499: C 04960301
500: C **** FCVS PROGRAM 301 - TEST 013 **** 04970301
501: C 04980301
502: C TEST 013 USES ONE CHARACTER TYPE-STATEMENT TO SPECIFY BOTH A 04990301
503: C VARIABLE AND AN ARRAY DECLARATOR. ONLY THE VARIABLE IS CHECKED 05000301
504: C IN THIS TEST. 05010301
505: C 05020301
506: IVTNUM = 13 05030301
507: IF (ICZERO) 30130, 0130, 30130 05040301
508: 0130 CONTINUE 05050301
509: CVTN01 = '12345678901234' 05060301
510: CVCOMP = ' ' 05070301
511: CVCORR = '12345678901234' 05080301
512: CVCOMP = CVTN01 05090301
513: 40130 IF (CVCOMP .EQ. '12345678901234') GO TO 10130 05100301
514: 40131 GO TO 20130 05110301
515: 30130 IVDELE = IVDELE + 1 05120301
516: WRITE (I02,80000) IVTNUM 05130301
517: IF (ICZERO) 10130, 0141, 20130 05140301
518: 10130 IVPASS = IVPASS + 1 05150301
519: WRITE (I02,80002) IVTNUM 05160301
520: GO TO 0141 05170301
521: 20130 IVFAIL = IVFAIL + 1 05180301
522: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05190301
523: 0141 CONTINUE 05200301
524: C 05210301
525: C **** FCVS PROGRAM 301 - TEST 014 **** 05220301
526: C 05230301
527: C TEST 014 CHECKS THE ARRAY DECLARATOR FROM THE PREVIOUS TEST. 05240301
528: C 05250301
529: IVTNUM = 14 05260301
530: IF (ICZERO) 30140, 0140, 30140 05270301
531: 0140 CONTINUE 05280301
532: CVCOMP = ' ' 05290301
533: CATN12(2) = 'ABCDEFGHIJKLMN' 05300301
534: CVCORR = 'ABCDEFGHIJKLMN' 05310301
535: CVCOMP = CATN12(2) 05320301
536: 40140 IF (CVCOMP .EQ. 'ABCDEFGHIJKLMN') GO TO 10140 05330301
537: 40141 GO TO 20140 05340301
538: 30140 IVDELE = IVDELE + 1 05350301
539: WRITE (I02,80000) IVTNUM 05360301
540: IF (ICZERO) 10140, 0151, 20140 05370301
541: 10140 IVPASS = IVPASS + 1 05380301
542: WRITE (I02,80002) IVTNUM 05390301
543: GO TO 0151 05400301
544: 20140 IVFAIL = IVFAIL + 1 05410301
545: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05420301
546: 0151 CONTINUE 05430301
547: C 05440301
548: C **** FCVS PROGRAM 301 - TEST 015 **** 05450301
549: C 05460301
550: C TEST 015 USES THE CHARACTER TYPE-STATEMENT TO SPECIFY AN 05470301
551: C ARRAY-NAME. THE ARRAY IS DECLARED IN A DIMENSION STATEMENT. 05480301
552: C 05490301
553: IVTNUM = 15 05500301
554: IF (ICZERO) 30150, 0150, 30150 05510301
555: 0150 CONTINUE 05520301
556: CVCOMP = ' ' 05530301
557: CADN13(3) = '12345678901234' 05540301
558: CVCORR = '12345678901234' 05550301
559: CVCOMP = CADN13(3) 05560301
560: 40150 IF (CVCOMP .EQ. '12345678901234') GO TO 10150 05570301
561: 40151 GO TO 20150 05580301
562: 30150 IVDELE = IVDELE + 1 05590301
563: WRITE (I02,80000) IVTNUM 05600301
564: IF (ICZERO) 10150, 0161, 20150 05610301
565: 10150 IVPASS = IVPASS + 1 05620301
566: WRITE (I02,80002) IVTNUM 05630301
567: GO TO 0161 05640301
568: 20150 IVFAIL = IVFAIL + 1 05650301
569: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05660301
570: 0161 CONTINUE 05670301
571: C 05680301
572: C **** FCVS PROGRAM 301 - TEST 016 **** 05690301
573: C 05700301
574: C TEST 016 USES THE CHARACTER TYPE-STATEMENT TO OVERRIDE THE 05710301
575: C IMPLICIT (DEFAULT) TYPING OF INTEGER. 05720301
576: C 05730301
577: IVTNUM = 16 05740301
578: IF (ICZERO) 30160, 0160, 30160 05750301
579: 0160 CONTINUE 05760301
580: CVCOMP = ' ' 05770301
581: KVTN05 = 'A' 05780301
582: CVCORR = 'A' 05790301
583: CVCOMP = KVTN05 05800301
584: 40160 IF (CVCOMP .EQ. 'A') GO TO 10160 05810301
585: 40161 GO TO 20160 05820301
586: 30160 IVDELE = IVDELE + 1 05830301
587: WRITE (I02,80000) IVTNUM 05840301
588: IF (ICZERO) 10160, 0171, 20160 05850301
589: 10160 IVPASS = IVPASS + 1 05860301
590: WRITE (I02,80002) IVTNUM 05870301
591: GO TO 0171 05880301
592: 20160 IVFAIL = IVFAIL + 1 05890301
593: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05900301
594: 0171 CONTINUE 05910301
595: C 05920301
596: C **** FCVS PROGRAM 301 - TEST 017 **** 05930301
597: C 05940301
598: C TEST 017 USES THE CHARACTER TYPE-STATEMENT TO OVERRIDE THE 05950301
599: C IMPLICIT TYPING OF THE LETTER 'G' AS INTEGER. 05960301
600: C 05970301
601: IVTNUM = 17 05980301
602: IF (ICZERO) 30170, 0170, 30170 05990301
603: 0170 CONTINUE 06000301
604: CVCOMP = ' ' 06010301
605: GVTN01 = 'ABC' 06020301
606: CVCORR = 'ABC' 06030301
607: CVCOMP = GVTN01 06040301
608: 40170 IF (CVCOMP .EQ. 'ABC') GO TO 10170 06050301
609: 40171 GO TO 20170 06060301
610: 30170 IVDELE = IVDELE + 1 06070301
611: WRITE (I02,80000) IVTNUM 06080301
612: IF (ICZERO) 10170, 0181, 20170 06090301
613: 10170 IVPASS = IVPASS + 1 06100301
614: WRITE (I02,80002) IVTNUM 06110301
615: GO TO 0181 06120301
616: 20170 IVFAIL = IVFAIL + 1 06130301
617: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 06140301
618: 0181 CONTINUE 06150301
619: C 06160301
620: C **** FCVS PROGRAM 301 - TEST 018 **** 06170301
621: C 06180301
622: C TEST 018 USES THE CHARAACTER TYPE-STATEMENT TO OVERRIDE THE 06190301
623: C LENGTH OF A CHARACTER FIELD DEFINED BY AN IMPLICIT STATEMENT. 06200301
624: C 06210301
625: IVTNUM = 18 06220301
626: IF (ICZERO) 30180, 0180, 30180 06230301
627: 0180 CONTINUE 06240301
628: CVCOMP = ' ' 06250301
629: FVTN01 = 'ABC' 06260301
630: CVCORR = 'ABC' 06270301
631: CVCOMP = FVTN01 06280301
632: 40180 IF (CVCOMP .EQ. 'ABC') GO TO 10180 06290301
633: 40181 GO TO 20180 06300301
634: 30180 IVDELE = IVDELE + 1 06310301
635: WRITE (I02,80000) IVTNUM 06320301
636: IF (ICZERO) 10180, 0191, 20180 06330301
637: 10180 IVPASS = IVPASS + 1 06340301
638: WRITE (I02,80002) IVTNUM 06350301
639: GO TO 0191 06360301
640: 20180 IVFAIL = IVFAIL + 1 06370301
641: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 06380301
642: 0191 CONTINUE 06390301
643: C 06400301
644: C **** FCVS PROGRAM 301 - TEST 019 **** 06410301
645: C 06420301
646: C TEST 019 USES THE TYPE-STATEMENT TO SPECIFY AN INTEGER 06430301
647: C STATEMENT FUNCTION. 06440301
648: C 06450301
649: IVTNUM = 19 06460301
650: IF (ICZERO) 30190, 0190, 30190 06470301
651: 0190 CONTINUE 06480301
652: IVCOMP = 0 06490301
653: IVON01 = 5 06500301
654: IVON02 = IFTN01(IVON01) 06510301
655: IVCORR = 6 06520301
656: IVCOMP = IVON02 06530301
657: 40190 IF (IVCOMP - 6) 20190, 10190, 20190 06540301
658: 30190 IVDELE = IVDELE + 1 06550301
659: WRITE (I02,80000) IVTNUM 06560301
660: IF (ICZERO) 10190, 0201, 20190 06570301
661: 10190 IVPASS = IVPASS + 1 06580301
662: WRITE (I02,80002) IVTNUM 06590301
663: GO TO 0201 06600301
664: 20190 IVFAIL = IVFAIL + 1 06610301
665: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06620301
666: 0201 CONTINUE 06630301
667: C 06640301
668: C 06650301
669: C WRITE OUT TEST SUMMARY 06660301
670: C 06670301
671: WRITE (I02,90004) 06680301
672: WRITE (I02,90014) 06690301
673: WRITE (I02,90004) 06700301
674: WRITE (I02,90000) 06710301
675: WRITE (I02,90004) 06720301
676: WRITE (I02,90020) IVFAIL 06730301
677: WRITE (I02,90022) IVPASS 06740301
678: WRITE (I02,90024) IVDELE 06750301
679: STOP 06760301
680: 90001 FORMAT (1H ,24X,5HFM301) 06770301
681: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM301) 06780301
682: C 06790301
683: C FORMATS FOR TEST DETAIL LINES 06800301
684: C 06810301
685: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 06820301
686: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 06830301
687: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 06840301
688: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 06850301
689: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 06860301
690: C 06870301
691: C FORMAT STATEMENTS FOR PAGE HEADERS 06880301
692: C 06890301
693: 90002 FORMAT (1H1) 06900301
694: 90004 FORMAT (1H ) 06910301
695: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 06920301
696: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 06930301
697: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 06940301
698: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 06950301
699: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 06960301
700: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 06970301
701: C 06980301
702: C FORMAT STATEMENTS FOR RUN SUMMARY 06990301
703: C 07000301
704: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 07010301
705: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 07020301
706: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 07030301
707: END 07040301
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.