![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM300.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 FM300.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 FM300 00010300
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 00020300
6: C 00030300
7: C THIS ROUTINE TESTS THE USE OF THE EQUIVALENCE STATEMENT TO 00040300
8: C EQUATE STORAGE UNITS OF VARIABLES, ARRAYS AND ARRAY ELEMENTS. 00050300
9: C ONLY INTEGER, REAL, LOGICAL AND CHARACTER DATA TYPES ARE TESTED. 00060300
10: C NO ATTEMPT IS MADE TO TEST DATA OF DIFFERENT TYPES THAT ARE 00070300
11: C EQUATED WITH THE EQUIVALENCE STATEMENT. 00080300
12: C 00090300
13: C REFERENCES. 00100300
14: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110300
15: C X3.9-1978 00120300
16: C 00130300
17: C SECTION 8.1, DIMENSION STATEMENT 00140300
18: C SECTION 8.2, EQUIVALENCE STATEMENT 00150300
19: C SECTION 9, DATA STATEMENT 00160300
20: C 00170300
21: C 00180300
22: C ******************************************************************00190300
23: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00200300
24: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00210300
25: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00220300
26: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00230300
27: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00240300
28: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00250300
29: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00260300
30: C THE RESULT OF EXECUTING THESE TESTS. 00270300
31: C 00280300
32: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00290300
33: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00300300
34: C 00310300
35: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00320300
36: C DEPARTMENT OF THE NAVY 00330300
37: C FEDERAL COBOL COMPILER TESTING SERVICE 00340300
38: C WASHINGTON, D.C. 20376 00350300
39: C 00360300
40: C ******************************************************************00370300
41: C 00380300
42: C 00390300
43: IMPLICIT LOGICAL (L) 00400300
44: IMPLICIT CHARACTER*14 (C) 00410300
45: C 00420300
46: 00430300
47: C *** SPECIFICATION STATEMENTS FOR TEST 001 *** 00440300
48: C 00450300
49: EQUIVALENCE (IVOE01, IVOE02) 00460300
50: C 00470300
51: C *** SPECIFICATION STATEMENTS FOR TEST 002 *** 00480300
52: C 00490300
53: EQUIVALENCE (RVOE01, RVOE02) 00500300
54: C 00510300
55: C *** SPECIFICATION STATEMENTS FOR TEST 003 *** 00520300
56: C 00530300
57: EQUIVALENCE (LVOE01, LVOE02) 00540300
58: C 00550300
59: C *** SPECIFICATION STATEMENTS FOR TEST 004 *** 00560300
60: C 00570300
61: CHARACTER CVTE01*3, CVTE02*3, CVCOMP*3 00580300
62: EQUIVALENCE (CVTE01, CVTE02) 00590300
63: C 00600300
64: C *** SPECIFICATION STATEMENTS FOR TEST 005 *** 00610300
65: C 00620300
66: EQUIVALENCE (IVOE03, IVOE04, IVOE05) 00630300
67: C 00640300
68: C *** SPECIFICATION STATEMENTS FOR TEST 006 *** 00650300
69: C 00660300
70: EQUIVALENCE (IVOE06, IVOE07, RVOE03) 00670300
71: C 00680300
72: C *** SPECIFICATION STATEMENTS FOR TESTS 007 AND 008 *** 00690300
73: C 00700300
74: EQUIVALENCE (IVOE08, IVOE09), (IVOE10, IVOE11) 00710300
75: C 00720300
76: C *** SPECIFICATION STATEMENTS FOR TEST 009 *** 00730300
77: C 00740300
78: EQUIVALENCE (IVOE12, IVOE13), (IVOE13, IVOE14) 00750300
79: C 00760300
80: C *** SPECIFICATION STATEMENTS FOR TEST 010 *** 00770300
81: C 00780300
82: EQUIVALENCE (IVOE15, IVOE16) 00790300
83: EQUIVALENCE (IVOE16, IVOE17) 00800300
84: C 00810300
85: C *** SPECIFICATION STATEMENTS FOR TESTS 011 AND 012 *** 00820300
86: C 00830300
87: DIMENSION IADE11(2), IADE12(3) 00840300
88: EQUIVALENCE (IADE11, IADE12) 00850300
89: C 00860300
90: C *** SPECIFICATION STATEMENTS FOR TESTS 013 AND 014 *** 00870300
91: C 00880300
92: DIMENSION RADE11(5), RADE12(5) 00890300
93: EQUIVALENCE (RADE11(4), RADE12(2)) 00900300
94: C 00910300
95: C *** SPECIFICATION STATEMENTS FOR TEST 015 *** 00920300
96: C 00930300
97: DIMENSION IADE13(4), IADE14(4) 00940300
98: EQUIVALENCE (IADE13, IADE14(3)) 00950300
99: C 00960300
100: C *** SPECIFICATION STATEMENTS FOR TEST 016 *** 00970300
101: C 00980300
102: DIMENSION IADE15(3) 00990300
103: EQUIVALENCE (IADE15(2), IVOE18) 01000300
104: C 01010300
105: C *** SPECIFICATION STATEMENTS FOR TESTS 017 AND 018 *** 01020300
106: C 01030300
107: DIMENSION IADE21(2,2), IADE16(4) 01040300
108: EQUIVALENCE (IADE21, IADE16) 01050300
109: C 01060300
110: C *** SPECIFICATION STATEMENTS FOR TEST 019 *** 01070300
111: C 01080300
112: EQUIVALENCE (IVOE19, IVOE20) 01090300
113: DATA IVOE19/19/ 01100300
114: C 01110300
115: C 01120300
116: C 01130300
117: C INITIALIZATION SECTION. 01140300
118: C 01150300
119: C INITIALIZE CONSTANTS 01160300
120: C ******************** 01170300
121: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01180300
122: I01 = 5 01190300
123: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01200300
124: I02 = 6 01210300
125: C SYSTEM ENVIRONMENT SECTION 01220300
126: C 01230300
127: I01 = 5 01240300
128: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01250300
129: C (UNIT NUMBER FOR CARD READER). 01260300
130: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01270300
131: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01280300
132: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01290300
133: C 01300300
134: I02 = 6 01310300
135: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01320300
136: C (UNIT NUMBER FOR PRINTER). 01330300
137: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01340300
138: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01350300
139: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01360300
140: C 01370300
141: IVPASS = 0 01380300
142: IVFAIL = 0 01390300
143: IVDELE = 0 01400300
144: ICZERO = 0 01410300
145: C 01420300
146: C WRITE OUT PAGE HEADERS 01430300
147: C 01440300
148: WRITE (I02,90002) 01450300
149: WRITE (I02,90006) 01460300
150: WRITE (I02,90008) 01470300
151: WRITE (I02,90004) 01480300
152: WRITE (I02,90010) 01490300
153: WRITE (I02,90004) 01500300
154: WRITE (I02,90016) 01510300
155: WRITE (I02,90001) 01520300
156: WRITE (I02,90004) 01530300
157: WRITE (I02,90012) 01540300
158: WRITE (I02,90014) 01550300
159: WRITE (I02,90004) 01560300
160: C 01570300
161: C 01580300
162: C **** FCVS PROGRAM 300 - TEST 001 **** 01590300
163: C 01600300
164: C THIS IS A TEST FOR EQUATING TWO INTEGER VARIABLES. 01610300
165: C 01620300
166: C 01630300
167: IVTNUM = 1 01640300
168: IF (ICZERO) 30010, 0010, 30010 01650300
169: 0010 CONTINUE 01660300
170: IVCOMP = 0 01670300
171: IVOE01 = 5 01680300
172: IVOE02 = 7 01690300
173: IVCORR = 7 01700300
174: IVCOMP = IVOE01 01710300
175: 40010 IF (IVCOMP - 7) 20010,10010,20010 01720300
176: 30010 IVDELE = IVDELE + 1 01730300
177: WRITE (I02,80000) IVTNUM 01740300
178: IF (ICZERO) 10010, 0021, 20010 01750300
179: 10010 IVPASS = IVPASS + 1 01760300
180: WRITE (I02,80002) IVTNUM 01770300
181: GO TO 0021 01780300
182: 20010 IVFAIL = IVFAIL + 1 01790300
183: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01800300
184: 0021 CONTINUE 01810300
185: C 01820300
186: C **** FCVS PROGRAM 300 - TEST 002 **** 01830300
187: C 01840300
188: C THIS IS A TEST FOR EQUATING TWO REAL VARIABLES. 01850300
189: C 01860300
190: C 01870300
191: IVTNUM = 2 01880300
192: IF (ICZERO) 30020, 0020, 30020 01890300
193: 0020 CONTINUE 01900300
194: RVCOMP = 0.0 01910300
195: RVOE01 = 4.5 01920300
196: RVOE02 = 1.2 01930300
197: RVCORR = 1.2 01940300
198: RVCOMP = RVOE01 01950300
199: 40020 IF (RVCOMP - 1.1995) 20020,10020,40021 01960300
200: 40021 IF (RVCOMP - 1.2005) 10020,10020,20020 01970300
201: 30020 IVDELE = IVDELE + 1 01980300
202: WRITE (I02,80000) IVTNUM 01990300
203: IF (ICZERO) 10020, 0031, 20020 02000300
204: 10020 IVPASS = IVPASS + 1 02010300
205: WRITE (I02,80002) IVTNUM 02020300
206: GO TO 0031 02030300
207: 20020 IVFAIL = IVFAIL + 1 02040300
208: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02050300
209: 0031 CONTINUE 02060300
210: C 02070300
211: C **** FCVS PROGRAM 300 - TEST 003 **** 02080300
212: C 02090300
213: C THIS IS A TEST FOR EQUATING TWO LOGICAL VARIABLES. 02100300
214: C 02110300
215: C 02120300
216: IVTNUM = 3 02130300
217: IF (ICZERO) 30030, 0030, 30030 02140300
218: 0030 CONTINUE 02150300
219: LVOE01 = .TRUE. 02160300
220: LVOE02 = .FALSE. 02170300
221: IVCORR = 0 02180300
222: IVCOMP = 0 02190300
223: IF (LVOE01) IVCOMP = 1 02200300
224: 40030 IF (IVCOMP) 20030,10030,20030 02210300
225: 30030 IVDELE = IVDELE + 1 02220300
226: WRITE (I02,80000) IVTNUM 02230300
227: IF (ICZERO) 10030, 0041, 20030 02240300
228: 10030 IVPASS = IVPASS + 1 02250300
229: WRITE (I02,80002) IVTNUM 02260300
230: GO TO 0041 02270300
231: 20030 IVFAIL = IVFAIL + 1 02280300
232: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02290300
233: 0041 CONTINUE 02300300
234: C 02310300
235: C **** FCVS PROGRAM 300 - TEST 004 **** 02320300
236: C 02330300
237: C THIS IS A TEST FOR EQUATING TWO CHARACTER VARIABLES. 02340300
238: C 02350300
239: C 02360300
240: IVTNUM = 4 02370300
241: IF (ICZERO) 30040, 0040, 30040 02380300
242: 0040 CONTINUE 02390300
243: CVCOMP = ' ' 02400300
244: CVTE01 = 'ABC' 02410300
245: CVTE02 = 'DEF' 02420300
246: CVCORR = 'DEF' 02430300
247: CVCOMP = CVTE01 02440300
248: 40040 IF (CVCOMP .EQ. 'DEF') GO TO 10040 02450300
249: 40041 GO TO 20040 02460300
250: 30040 IVDELE = IVDELE + 1 02470300
251: WRITE (I02,80000) IVTNUM 02480300
252: IF (ICZERO) 10040, 0051, 20040 02490300
253: 10040 IVPASS = IVPASS + 1 02500300
254: WRITE (I02,80002) IVTNUM 02510300
255: GO TO 0051 02520300
256: 20040 IVFAIL = IVFAIL + 1 02530300
257: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 02540300
258: 0051 CONTINUE 02550300
259: C 02560300
260: C **** FCVS PROGRAM 300 - TEST 005 **** 02570300
261: C 02580300
262: C THIS IS A TEST FOR EQUATING THREE INTEGER VARIABLES. 02590300
263: C 02600300
264: C 02610300
265: IVTNUM = 5 02620300
266: IF (ICZERO) 30050, 0050, 30050 02630300
267: 0050 CONTINUE 02640300
268: IVCOMP = 0 02650300
269: IVOE03 = 3 02660300
270: IVOE04 = 4 02670300
271: IVOE05 = 5 02680300
272: IVCORR = 5 02690300
273: IVCOMP = IVOE03 02700300
274: 40050 IF (IVCOMP - 5) 20050,40051,20050 02710300
275: 40051 IVCOMP = IVOE04 02720300
276: 40052 IF (IVCOMP - 5) 20050,10050,20050 02730300
277: 30050 IVDELE = IVDELE + 1 02740300
278: WRITE (I02,80000) IVTNUM 02750300
279: IF (ICZERO) 10050, 0061, 20050 02760300
280: 10050 IVPASS = IVPASS + 1 02770300
281: WRITE (I02,80002) IVTNUM 02780300
282: GO TO 0061 02790300
283: 20050 IVFAIL = IVFAIL + 1 02800300
284: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02810300
285: 0061 CONTINUE 02820300
286: C 02830300
287: C **** FCVS PROGRAM 300 - TEST 006 **** 02840300
288: C 02850300
289: C THIS IS A TEST FOR EQUATING TWO INTEGER VARIABLES AND ONE 02860300
290: C REAL VARIABLE WITHIN ONE EQUIVALENCE STATEMENT LIST OF NAMES. THE02870300
291: C VALUE OF THE REAL VARIABLE IS NOT TESTED. 02880300
292: C 02890300
293: C 02900300
294: IVTNUM = 6 02910300
295: IF (ICZERO) 30060, 0060, 30060 02920300
296: 0060 CONTINUE 02930300
297: IVCOMP = 0 02940300
298: RVOE03 = 3.445 02950300
299: IVOE06 = 6 02960300
300: IVOE07 = 7 02970300
301: IVCORR = 7 02980300
302: IVCOMP = IVOE06 02990300
303: 40060 IF (IVCOMP - 7) 20060,10060,20060 03000300
304: 30060 IVDELE = IVDELE + 1 03010300
305: WRITE (I02,80000) IVTNUM 03020300
306: IF (ICZERO) 10060, 0071, 20060 03030300
307: 10060 IVPASS = IVPASS + 1 03040300
308: WRITE (I02,80002) IVTNUM 03050300
309: GO TO 0071 03060300
310: 20060 IVFAIL = IVFAIL + 1 03070300
311: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03080300
312: 0071 CONTINUE 03090300
313: C 03100300
314: C **** FCVS PROGRAM 300 - TEST 007 **** 03110300
315: C 03120300
316: C THIS IS A TEST FOR EQUATING INTEGER VARIABLES USING TWO LISTS 03130300
317: C OF NAMES IN ONE EQUIVALENCE STATEMENT. NAMES SPECIFIED IN THE 03140300
318: C FIRST LIST ARE NOT EQUATED TO NAMES IN THE SECOND LIST. THIS 03150300
319: C TEST CHECKS THE EQUIVALINCE OF THE VARIABLES IN THE FIRST LIST. 03160300
320: C 03170300
321: C 03180300
322: IVTNUM = 7 03190300
323: IF (ICZERO) 30070, 0070, 30070 03200300
324: 0070 CONTINUE 03210300
325: IVCOMP = 0 03220300
326: IVOE08 = 8 03230300
327: IVOE09 = 9 03240300
328: IVOE10 = 10 03250300
329: IVOE11 = 11 03260300
330: IVCORR = 9 03270300
331: IVCOMP = IVOE08 03280300
332: 40070 IF (IVCOMP - 9) 20070,10070,20070 03290300
333: 30070 IVDELE = IVDELE + 1 03300300
334: WRITE (I02,80000) IVTNUM 03310300
335: IF (ICZERO) 10070, 0081, 20070 03320300
336: 10070 IVPASS = IVPASS + 1 03330300
337: WRITE (I02,80002) IVTNUM 03340300
338: GO TO 0081 03350300
339: 20070 IVFAIL = IVFAIL + 1 03360300
340: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03370300
341: 0081 CONTINUE 03380300
342: C 03390300
343: C **** FCVS PROGRAM 300 - TEST 008 **** 03400300
344: C 03410300
345: C THIS TEST CHECKS THE EQUIVALENCE OF THE VARIABLES IN THE 03420300
346: C SECOND LIST. 03430300
347: C 03440300
348: C 03450300
349: IVTNUM = 8 03460300
350: IF (ICZERO) 30080, 0080, 30080 03470300
351: 0080 CONTINUE 03480300
352: IVCOMP = 0 03490300
353: IVCORR = 11 03500300
354: IVCOMP = IVOE10 03510300
355: 40080 IF (IVCOMP - 11) 20080,10080,20080 03520300
356: 30080 IVDELE = IVDELE + 1 03530300
357: WRITE (I02,80000) IVTNUM 03540300
358: IF (ICZERO) 10080, 0091, 20080 03550300
359: 10080 IVPASS = IVPASS + 1 03560300
360: WRITE (I02,80002) IVTNUM 03570300
361: GO TO 0091 03580300
362: 20080 IVFAIL = IVFAIL + 1 03590300
363: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03600300
364: 0091 CONTINUE 03610300
365: C 03620300
366: C **** FCVS PROGRAM 300 - TEST 009 **** 03630300
367: C 03640300
368: C THIS IS A TEST FOR EQUATING INTEGER VARIABLES IN ONE LIST 03650300
369: C WITH INTEGER VARIABLES IN A SECOND LIST OF THE SAME EQUIVALENCE 03660300
370: C STATEMENT. ALL VARIABLES SHOULD BE EQUATED AND SHARE THE SAME 03670300
371: C STORAGE UNIT. 03680300
372: C 03690300
373: C 03700300
374: IVTNUM = 9 03710300
375: IF (ICZERO) 30090, 0090, 30090 03720300
376: 0090 CONTINUE 03730300
377: IVCOMP = 0 03740300
378: IVOE12 = 12 03750300
379: IVOE13 = 13 03760300
380: IVOE14 = 14 03770300
381: IVCORR = 14 03780300
382: IVCOMP = IVOE13 03790300
383: 40090 IF (IVCOMP - 14) 20090,40091,20090 03800300
384: 40091 IVCOMP = IVOE12 03810300
385: 40092 IF (IVCOMP - 14) 20090,10090,20090 03820300
386: 30090 IVDELE = IVDELE + 1 03830300
387: WRITE (I02,80000) IVTNUM 03840300
388: IF (ICZERO) 10090, 0101, 20090 03850300
389: 10090 IVPASS = IVPASS + 1 03860300
390: WRITE (I02,80002) IVTNUM 03870300
391: GO TO 0101 03880300
392: 20090 IVFAIL = IVFAIL + 1 03890300
393: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03900300
394: 0101 CONTINUE 03910300
395: C 03920300
396: C **** FCVS PROGRAM 300 - TEST 010 **** 03930300
397: C 03940300
398: C THIS IS A TEST FOR EQUATING INTEGER VARIABLES SPECIFIED IN ONE 03950300
399: C EQUIVALENCE STATEMENT WITH INTEGER VARIABLES SPECIFIED IN A 03960300
400: C SECOND EQUIVALENCE STATEMENT. ONE VARIABLE IS SPECIFIED IN BOTH 03970300
401: C STATEMENTS, THEREFORE ALL VARIABLES SHOULD BE EQUATED AND SHARE 03980300
402: C THE SAME STORAGE UNIT. 03990300
403: C 04000300
404: C 04010300
405: IVTNUM = 10 04020300
406: IF (ICZERO) 30100, 0100, 30100 04030300
407: 0100 CONTINUE 04040300
408: IVCOMP = 0 04050300
409: IVOE15 = 15 04060300
410: IVOE16 = 16 04070300
411: IVOE17 = 17 04080300
412: IVCORR = 17 04090300
413: IVCOMP = IVOE16 04100300
414: 40100 IF (IVCOMP - 17) 20100,40101,20100 04110300
415: 40101 IVCOMP = IVOE15 04120300
416: 40102 IF (IVCOMP - 17) 20100,10100,20100 04130300
417: 30100 IVDELE = IVDELE + 1 04140300
418: WRITE (I02,80000) IVTNUM 04150300
419: IF (ICZERO) 10100, 0111, 20100 04160300
420: 10100 IVPASS = IVPASS + 1 04170300
421: WRITE (I02,80002) IVTNUM 04180300
422: GO TO 0111 04190300
423: 20100 IVFAIL = IVFAIL + 1 04200300
424: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04210300
425: 0111 CONTINUE 04220300
426: C 04230300
427: C **** FCVS PROGRAM 300 - TEST 011 **** 04240300
428: C 04250300
429: C THIS IS A TEST FOR EQUATING TWO INTEGER ARRAYS UNQUALIFIED 04260300
430: C BY A SUBSCRIPT IN THE EQUIVALENCE STATEMENT. ALL ARRAY ELEMENTS 04270300
431: C SPECIFIED BY THE SAME SUBSCRIPT VALUE, BEGINNING WITH THE FIRST 04280300
432: C ARRAY ELEMENT, SHOULD BE EQUATED AND SHARE THE SAME STORAGE UNIT. 04290300
433: C THIS TEST CHECKS THE EQUIVALENCE OF THE FIRST ARRAY ELEMENTS. 04300300
434: C 04310300
435: C 04320300
436: IVTNUM = 11 04330300
437: IF (ICZERO) 30110, 0110, 30110 04340300
438: 0110 CONTINUE 04350300
439: IVCOMP = 0 04360300
440: IADE11(1) = 111 04370300
441: IADE11(2) = 112 04380300
442: IADE12(1) = 121 04390300
443: IADE12(2) = 122 04400300
444: IADE12(3) = 123 04410300
445: IVCORR = 121 04420300
446: IVCOMP = IADE11(1) 04430300
447: 40110 IF (IVCOMP - 121) 20110,10110,20110 04440300
448: 30110 IVDELE = IVDELE + 1 04450300
449: WRITE (I02,80000) IVTNUM 04460300
450: IF (ICZERO) 10110, 0121, 20110 04470300
451: 10110 IVPASS = IVPASS + 1 04480300
452: WRITE (I02,80002) IVTNUM 04490300
453: GO TO 0121 04500300
454: 20110 IVFAIL = IVFAIL + 1 04510300
455: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04520300
456: 0121 CONTINUE 04530300
457: C 04540300
458: C **** FCVS PROGRAM 300 - TEST 012 **** 04550300
459: C 04560300
460: C THIS TEST CHECKS THE EQUIVALENCE OF THE SECOND ARRAY ELEMENTS. 04570300
461: C 04580300
462: C 04590300
463: IVTNUM = 12 04600300
464: IF (ICZERO) 30120, 0120, 30120 04610300
465: 0120 CONTINUE 04620300
466: IVCOMP = 0 04630300
467: IVCORR = 122 04640300
468: IVCOMP = IADE11(2) 04650300
469: 40120 IF (IVCOMP - 122) 20120,10120,20120 04660300
470: 30120 IVDELE = IVDELE + 1 04670300
471: WRITE (I02,80000) IVTNUM 04680300
472: IF (ICZERO) 10120, 0131, 20120 04690300
473: 10120 IVPASS = IVPASS + 1 04700300
474: WRITE (I02,80002) IVTNUM 04710300
475: GO TO 0131 04720300
476: 20120 IVFAIL = IVFAIL + 1 04730300
477: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04740300
478: 0131 CONTINUE 04750300
479: C 04760300
480: C **** FCVS PROGRAM 300 - TEST 013 **** 04770300
481: C 04780300
482: C THIS IS A TEST FOR EQUATING TWO REAL ARRAY ELEMENTS. THIS 04790300
483: C TEST CHECKS THE EQUIVALENCE OF THE TWO ARRAY ELEMENTS SPECIFIED 04800300
484: C IN THE EQUIVALENCE STATEMENT. 04810300
485: C 04820300
486: C 04830300
487: IVTNUM = 13 04840300
488: IF (ICZERO) 30130, 0130, 30130 04850300
489: 0130 CONTINUE 04860300
490: RVCOMP = 0.0 04870300
491: RADE11(4) = 11.4 04880300
492: RADE12(2) = 1.22 04890300
493: RVCORR = 1.22 04900300
494: RVCOMP = RADE11(4) 04910300
495: 40130 IF (RVCOMP - 1.2195) 20130,10130,40131 04920300
496: 40131 IF (RVCOMP - 1.2205) 10130,10130,20130 04930300
497: 30130 IVDELE = IVDELE + 1 04940300
498: WRITE (I02,80000) IVTNUM 04950300
499: IF (ICZERO) 10130, 0141, 20130 04960300
500: 10130 IVPASS = IVPASS + 1 04970300
501: WRITE (I02,80002) IVTNUM 04980300
502: GO TO 0141 04990300
503: 20130 IVFAIL = IVFAIL + 1 05000300
504: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05010300
505: 0141 CONTINUE 05020300
506: C 05030300
507: C **** FCVS PROGRAM 300 - TEST 014 **** 05040300
508: C 05050300
509: C THIS TEST CHECKS THE EQUIVALENCE OF THE ARRAY ELEMENTS 05060300
510: C WITH A SUBSCRIPT VALUE ONE LESS THAN THOSE TESTED IN THE 05070300
511: C PREVIOUS TEST. THESE ELEMENTS SHOULD BE EQUATED AND SHARE THE 05080300
512: C SAME STORAGE UNIT DUE TO THE WAY ARRAY ELEMENTS OCCUPY 05090300
513: C CONSECUTIVE STORAGE UNITS. 05100300
514: C 05110300
515: C 05120300
516: IVTNUM = 14 05130300
517: IF (ICZERO) 30140, 0140, 30140 05140300
518: 0140 CONTINUE 05150300
519: RVCOMP = 0.0 05160300
520: RADE11(3) = .113 05170300
521: RADE12(1) = 122. 05180300
522: RVCORR = 122. 05190300
523: RVCOMP = RADE11(3) 05200300
524: 40140 IF (RVCOMP - 121.95) 20140,10140,40141 05210300
525: 40141 IF (RVCOMP - 122.05) 10140,10140,20140 05220300
526: 30140 IVDELE = IVDELE + 1 05230300
527: WRITE (I02,80000) IVTNUM 05240300
528: IF (ICZERO) 10140, 0151, 20140 05250300
529: 10140 IVPASS = IVPASS + 1 05260300
530: WRITE (I02,80002) IVTNUM 05270300
531: GO TO 0151 05280300
532: 20140 IVFAIL = IVFAIL + 1 05290300
533: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05300300
534: 0151 CONTINUE 05310300
535: C 05320300
536: C **** FCVS PROGRAM 300 - TEST 015 **** 05330300
537: C 05340300
538: C THIS IS A TEST TO EQUATE AN ARRAY NAME TO AN ARRAY ELEMENT 05350300
539: C NAME. 05360300
540: C 05370300
541: C 05380300
542: IVTNUM = 15 05390300
543: IF (ICZERO) 30150, 0150, 30150 05400300
544: 0150 CONTINUE 05410300
545: IVCOMP = 0 05420300
546: IADE13(1) = 131 05430300
547: IADE14(3) = 143 05440300
548: IVCORR = 143 05450300
549: IVCOMP = IADE13(1) 05460300
550: 40150 IF (IVCOMP - 143) 20150,10150,20150 05470300
551: 30150 IVDELE = IVDELE + 1 05480300
552: WRITE (I02,80000) IVTNUM 05490300
553: IF (ICZERO) 10150, 0161, 20150 05500300
554: 10150 IVPASS = IVPASS + 1 05510300
555: WRITE (I02,80002) IVTNUM 05520300
556: GO TO 0161 05530300
557: 20150 IVFAIL = IVFAIL + 1 05540300
558: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05550300
559: 0161 CONTINUE 05560300
560: C 05570300
561: C **** FCVS PROGRAM 300 - TEST 016 **** 05580300
562: C 05590300
563: C THIS IS A TEST TO EQUATE AN ARRAY ELEMENT TO AN INTEGER 05600300
564: C VARIABLE. 05610300
565: C 05620300
566: C 05630300
567: IVTNUM = 16 05640300
568: IF (ICZERO) 30160, 0160, 30160 05650300
569: 0160 CONTINUE 05660300
570: IVCOMP = 0 05670300
571: IADE15(2) = 152 05680300
572: IVOE18 = 18 05690300
573: IVCORR = 18 05700300
574: IVCOMP = IADE15(2) 05710300
575: 40160 IF (IVCOMP - 18) 20160,10160,20160 05720300
576: 30160 IVDELE = IVDELE + 1 05730300
577: WRITE (I02,80000) IVTNUM 05740300
578: IF (ICZERO) 10160, 0171, 20160 05750300
579: 10160 IVPASS = IVPASS + 1 05760300
580: WRITE (I02,80002) IVTNUM 05770300
581: GO TO 0171 05780300
582: 20160 IVFAIL = IVFAIL + 1 05790300
583: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05800300
584: 0171 CONTINUE 05810300
585: C 05820300
586: C **** FCVS PROGRAM 300 - TEST 017 **** 05830300
587: C 05840300
588: C THIS IS A TEST TO EQUATE A ONE DIMENSIONAL ARRAY TO A TWO 05850300
589: C DIMENSIONAL ARRAY. THIS TEST CHECKS THE SECOND ARRAY ELEMENTS. 05860300
590: C 05870300
591: C 05880300
592: IVTNUM = 17 05890300
593: IF (ICZERO) 30170, 0170, 30170 05900300
594: 0170 CONTINUE 05910300
595: IVCOMP = 0 05920300
596: IADE21(2,1) = 212 05930300
597: IADE16(2) = 162 05940300
598: IVCORR = 162 05950300
599: IVCOMP = IADE21(2,1) 05960300
600: 40170 IF (IVCOMP - 162) 20170,10170,20170 05970300
601: 30170 IVDELE = IVDELE + 1 05980300
602: WRITE (I02,80000) IVTNUM 05990300
603: IF (ICZERO) 10170, 0181, 20170 06000300
604: 10170 IVPASS = IVPASS + 1 06010300
605: WRITE (I02,80002) IVTNUM 06020300
606: GO TO 0181 06030300
607: 20170 IVFAIL = IVFAIL + 1 06040300
608: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06050300
609: 0181 CONTINUE 06060300
610: C 06070300
611: C **** FCVS PROGRAM 300 - TEST 018 **** 06080300
612: C 06090300
613: C THIS TEST CHECKS THE THIRD ARRAY ELEMENTS FROM THE PREVIOUS 06100300
614: C TEST. 06110300
615: C 06120300
616: C 06130300
617: IVTNUM = 18 06140300
618: IF (ICZERO) 30180, 0180, 30180 06150300
619: 0180 CONTINUE 06160300
620: IVCOMP = 0 06170300
621: IADE21(1,2) = 2112 06180300
622: IADE16(3) = 163 06190300
623: IVCORR = 163 06200300
624: IVCOMP = IADE21(1,2) 06210300
625: 40180 IF (IVCOMP - 163) 20180,10180,20180 06220300
626: 30180 IVDELE = IVDELE + 1 06230300
627: WRITE (I02,80000) IVTNUM 06240300
628: IF (ICZERO) 10180, 0191, 20180 06250300
629: 10180 IVPASS = IVPASS + 1 06260300
630: WRITE (I02,80002) IVTNUM 06270300
631: GO TO 0191 06280300
632: 20180 IVFAIL = IVFAIL + 1 06290300
633: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06300300
634: 0191 CONTINUE 06310300
635: C 06320300
636: C **** FCVS PROGRAM 300 - TEST 019 **** 06330300
637: C 06340300
638: C THIS IS A TEST TO EQUATE TWO INTEGER VARIABLES ONE OF WHICH 06350300
639: C IS INITIALIZED IN A DATA STATEMENT. 06360300
640: C 06370300
641: C 06380300
642: IVTNUM = 19 06390300
643: IF (ICZERO) 30190, 0190, 30190 06400300
644: 0190 CONTINUE 06410300
645: IVCOMP = 0 06420300
646: IVCORR = 19 06430300
647: IVCOMP = IVOE20 06440300
648: 40190 IF (IVCOMP - 19) 20190,10190,20190 06450300
649: 30190 IVDELE = IVDELE + 1 06460300
650: WRITE (I02,80000) IVTNUM 06470300
651: IF (ICZERO) 10190, 0201, 20190 06480300
652: 10190 IVPASS = IVPASS + 1 06490300
653: WRITE (I02,80002) IVTNUM 06500300
654: GO TO 0201 06510300
655: 20190 IVFAIL = IVFAIL + 1 06520300
656: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06530300
657: 0201 CONTINUE 06540300
658: C 06550300
659: C 06560300
660: C WRITE OUT TEST SUMMARY 06570300
661: C 06580300
662: WRITE (I02,90004) 06590300
663: WRITE (I02,90014) 06600300
664: WRITE (I02,90004) 06610300
665: WRITE (I02,90000) 06620300
666: WRITE (I02,90004) 06630300
667: WRITE (I02,90020) IVFAIL 06640300
668: WRITE (I02,90022) IVPASS 06650300
669: WRITE (I02,90024) IVDELE 06660300
670: STOP 06670300
671: 90001 FORMAT (1H ,24X,5HFM300) 06680300
672: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM300) 06690300
673: C 06700300
674: C FORMATS FOR TEST DETAIL LINES 06710300
675: C 06720300
676: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 06730300
677: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 06740300
678: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 06750300
679: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 06760300
680: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 06770300
681: C 06780300
682: C FORMAT STATEMENTS FOR PAGE HEADERS 06790300
683: C 06800300
684: 90002 FORMAT (1H1) 06810300
685: 90004 FORMAT (1H ) 06820300
686: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 06830300
687: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 06840300
688: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 06850300
689: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 06860300
690: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 06870300
691: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 06880300
692: C 06890300
693: C FORMAT STATEMENTS FOR RUN SUMMARY 06900300
694: C 06910300
695: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 06920300
696: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 06930300
697: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 06940300
698: END 06950300
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.