![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM025.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 FM025.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. 00010025
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 00020025
6: C FM025 00030025
7: C 00040025
8: C THIS ROUTINE TESTS ARRAYS WITH IF STATEMENTS, DO LOOPS, 00050025
9: C ASSIGNED AND COMPUTED GO TO STATEMENTS IN CONJUNCTION WITH ARRAY 00060025
10: C ELEMENTS IN COMMON OR DIMENSIONED. ONE, TWO, AND THREE 00070025
11: C DIMENSIONED ARRAYS ARE USED. THE SUBSCRIPTS ARE INTEGER CONSTANTS00080025
12: C OR SOMETIMES INTEGER VARIABLES WHEN THE ELEMENTS ARE IN LOOPS 00090025
13: C AND ALL ARRAYS HAVE FIXED SIZE LIMITS. INTEGER, REAL, AND LOGICAL00100025
14: C ARRAYS ARE USED WITH THE TYPE SOMETIMES SPECIFIED WITH THE 00110025
15: C EXPLICIT TYPE STATEMENT. 00120025
16: C 00130025
17: C REFERENCES 00140025
18: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150025
19: C X3.9-1978 00160025
20: C 00170025
21: C SECTION 8, SPECIFICATION STATEMENTS 00180025
22: C SECTION 8.1, DIMENSION STATEMENT 00190025
23: C SECTION 8.3, COMMON STATEMENT 00200025
24: C SECTION 8.4, TYPE-STATEMENTS 00210025
25: C SECTION 9, DATA STATEMENT 00220025
26: C SECTION 11.2, COMPUTED GO TO STATEMENT 00230025
27: C SECTION 11.3, ASSIGNED GO TO STATEMENT 00240025
28: C SECTION 11.10, DO STATEMENT 00250025
29: C 00260025
30: COMMON IADN31(2,2,2), RADN31(2,2,2), LADN31(2,2,2) 00270025
31: C 00280025
32: DIMENSION IADN32(2,2,2), IADN21(2,2), IADN11(2) 00290025
33: C 00300025
34: LOGICAL LADN31 00310025
35: INTEGER RADN33(2,2,2), RADN21(2,4), RADN11(8) 00320025
36: REAL IADN33(2,2,2), IADN22(2,4), IADN12(8) 00330025
37: C 00340025
38: C 00350025
39: C ********************************************************** 00360025
40: C 00370025
41: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00380025
42: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00390025
43: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00400025
44: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00410025
45: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00420025
46: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00430025
47: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00440025
48: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00450025
49: C OF EXECUTING THESE TESTS. 00460025
50: C 00470025
51: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00480025
52: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00490025
53: C 00500025
54: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00510025
55: C 00520025
56: C DEPARTMENT OF THE NAVY 00530025
57: C FEDERAL COBOL COMPILER TESTING SERVICE 00540025
58: C WASHINGTON, D.C. 20376 00550025
59: C 00560025
60: C ********************************************************** 00570025
61: C 00580025
62: C 00590025
63: C 00600025
64: C INITIALIZATION SECTION 00610025
65: C 00620025
66: C INITIALIZE CONSTANTS 00630025
67: C ************** 00640025
68: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650025
69: I01 = 5 00660025
70: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670025
71: I02 = 6 00680025
72: C SYSTEM ENVIRONMENT SECTION 00690025
73: C 00700025
74: I01 = 5 00710025
75: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720025
76: C (UNIT NUMBER FOR CARD READER). 00730025
77: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00740025
78: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00750025
79: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00760025
80: C 00770025
81: I02 = 6 00780025
82: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00790025
83: C (UNIT NUMBER FOR PRINTER). 00800025
84: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00810025
85: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00820025
86: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00830025
87: C 00840025
88: IVPASS=0 00850025
89: IVFAIL=0 00860025
90: IVDELE=0 00870025
91: ICZERO=0 00880025
92: C 00890025
93: C WRITE PAGE HEADERS 00900025
94: WRITE (I02,90000) 00910025
95: WRITE (I02,90001) 00920025
96: WRITE (I02,90002) 00930025
97: WRITE (I02, 90002) 00940025
98: WRITE (I02,90003) 00950025
99: WRITE (I02,90002) 00960025
100: WRITE (I02,90004) 00970025
101: WRITE (I02,90002) 00980025
102: WRITE (I02,90011) 00990025
103: WRITE (I02,90002) 01000025
104: WRITE (I02,90002) 01010025
105: WRITE (I02,90005) 01020025
106: WRITE (I02,90006) 01030025
107: WRITE (I02,90002) 01040025
108: IVTNUM = 653 01050025
109: C 01060025
110: C **** TEST 653 **** 01070025
111: C TEST 653 - TEST OF SETTING ALL VALUES OF AN INTEGER ARRAY 01080025
112: C BY THE INTEGER INDEX OF A DO LOOP. THE ARRAY HAS ONE DIMENSION. 01090025
113: C 01100025
114: IF (ICZERO) 36530, 6530, 36530 01110025
115: 6530 CONTINUE 01120025
116: DO 6532 I = 1,2,1 01130025
117: IADN11(I) = I 01140025
118: 6532 CONTINUE 01150025
119: IVCOMP = IADN11(1) 01160025
120: GO TO 46530 01170025
121: 36530 IVDELE = IVDELE + 1 01180025
122: WRITE (I02,80003) IVTNUM 01190025
123: IF (ICZERO) 46530, 6541, 46530 01200025
124: 46530 IF ( IVCOMP - 1 ) 26530, 16530, 26530 01210025
125: 16530 IVPASS = IVPASS + 1 01220025
126: WRITE (I02,80001) IVTNUM 01230025
127: GO TO 6541 01240025
128: 26530 IVFAIL = IVFAIL + 1 01250025
129: IVCORR = 1 01260025
130: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01270025
131: 6541 CONTINUE 01280025
132: IVTNUM = 654 01290025
133: C 01300025
134: C **** TEST 654 **** 01310025
135: C TEST 654 - SEE TEST 653. THIS TEST CHECKS THE SECOND ELEMENT OF01320025
136: C THE INTEGER ARRAY IADN11(2). 01330025
137: C 01340025
138: IF (ICZERO) 36540, 6540, 36540 01350025
139: 6540 CONTINUE 01360025
140: IVCOMP = IADN11(2) 01370025
141: GO TO 46540 01380025
142: 36540 IVDELE = IVDELE + 1 01390025
143: WRITE (I02,80003) IVTNUM 01400025
144: IF (ICZERO) 46540, 6551, 46540 01410025
145: 46540 IF ( IVCOMP - 2 ) 26540, 16540, 26540 01420025
146: 16540 IVPASS = IVPASS + 1 01430025
147: WRITE (I02,80001) IVTNUM 01440025
148: GO TO 6551 01450025
149: 26540 IVFAIL = IVFAIL + 1 01460025
150: IVCORR = 2 01470025
151: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01480025
152: 6551 CONTINUE 01490025
153: IVTNUM = 655 01500025
154: C 01510025
155: C **** TEST 655 **** 01520025
156: C TEST 655 - TEST OF SETTING THE VALUES OF THE COLUMN OF A TWO 01530025
157: C DIMENSION INTEGER ARRAY BY A DO LOOP. THE VALUES FOR THE ELEMENTS01540025
158: C IN A COLUMN IS THE NUMBER OF THE COLUMN AS SET BY THE DO LOOP 01550025
159: C INDEX. ROW NUMBERS ARE INTEGER CONSTANTS. 01560025
160: C THE VALUES FOR THE ELEMENTS ARE AS FOLLOWS 01570025
161: C 1 2 01580025
162: C 1 2 01590025
163: C 01600025
164: IF (ICZERO) 36550, 6550, 36550 01610025
165: 6550 CONTINUE 01620025
166: DO 6552 J = 1, 2 01630025
167: IADN21(1,J) = J 01640025
168: IADN21(2,J) = J 01650025
169: 6552 CONTINUE 01660025
170: IVCOMP = IADN21(1,1) 01670025
171: GO TO 46550 01680025
172: 36550 IVDELE = IVDELE + 1 01690025
173: WRITE (I02,80003) IVTNUM 01700025
174: IF (ICZERO) 46550, 6561, 46550 01710025
175: 46550 IF ( IVCOMP - 1 ) 26550, 16550, 26550 01720025
176: 16550 IVPASS = IVPASS + 1 01730025
177: WRITE (I02,80001) IVTNUM 01740025
178: GO TO 6561 01750025
179: 26550 IVFAIL = IVFAIL + 1 01760025
180: IVCORR = 1 01770025
181: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01780025
182: 6561 CONTINUE 01790025
183: IVTNUM = 656 01800025
184: C 01810025
185: C **** TEST 656 **** 01820025
186: C TEST 656 - SEE TEST 655. THIS TEST CHECKS THE VALUE OF THE 01830025
187: C INTEGER ARRAY IADN21(2,2) 01840025
188: C 01850025
189: IF (ICZERO) 36560, 6560, 36560 01860025
190: 6560 CONTINUE 01870025
191: IVCOMP = IADN21(2,2) 01880025
192: GO TO 46560 01890025
193: 36560 IVDELE = IVDELE + 1 01900025
194: WRITE (I02,80003) IVTNUM 01910025
195: IF (ICZERO) 46560, 6571, 46560 01920025
196: 46560 IF ( IVCOMP - 2 ) 26560, 16560, 26560 01930025
197: 16560 IVPASS = IVPASS + 1 01940025
198: WRITE (I02,80001) IVTNUM 01950025
199: GO TO 6571 01960025
200: 26560 IVFAIL = IVFAIL + 1 01970025
201: IVCORR = 2 01980025
202: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01990025
203: 6571 CONTINUE 02000025
204: IVTNUM = 657 02010025
205: C 02020025
206: C **** TEST 657 **** 02030025
207: C TEST 657 - THIS TESTS SETTING BOTH THE ROW AND COLUMN SUBSCRIPTS02040025
208: C IN A TWO DIMENSION INTEGER ARRAY WITH A DOUBLE NESTED DO LOOP. 02050025
209: C THE ELEMENT VALUES ARE SET BY AN INTEGER COUNTER. ELEMENT VALUES 02060025
210: C ARE AS FOLLOWS 1 2 02070025
211: C 3 4 02080025
212: C 02090025
213: IF (ICZERO) 36570, 6570, 36570 02100025
214: 6570 CONTINUE 02110025
215: ICON01 = 0 02120025
216: DO 6573 I = 1, 2 02130025
217: DO 6572 J = 1, 2 02140025
218: ICON01 = ICON01 + 1 02150025
219: IADN21(I,J) = ICON01 02160025
220: 6572 CONTINUE 02170025
221: 6573 CONTINUE 02180025
222: IVCOMP = IADN21(1,2) 02190025
223: GO TO 46570 02200025
224: 36570 IVDELE = IVDELE + 1 02210025
225: WRITE (I02,80003) IVTNUM 02220025
226: IF (ICZERO) 46570, 6581, 46570 02230025
227: 46570 IF ( IVCOMP - 2 ) 26570, 16570, 26570 02240025
228: 16570 IVPASS = IVPASS + 1 02250025
229: WRITE (I02,80001) IVTNUM 02260025
230: GO TO 6581 02270025
231: 26570 IVFAIL = IVFAIL + 1 02280025
232: IVCORR = 2 02290025
233: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02300025
234: 6581 CONTINUE 02310025
235: IVTNUM = 658 02320025
236: C 02330025
237: C **** TEST 658 **** 02340025
238: C TEST 658 - SEE TEST 657. THIS TEST CHECKS THE VALUE OF ARRAY 02350025
239: C ELEMENT IADN21(2,1) = 3 02360025
240: C 02370025
241: IF (ICZERO) 36580, 6580, 36580 02380025
242: 6580 CONTINUE 02390025
243: IVCOMP = IADN21(2,1) 02400025
244: GO TO 46580 02410025
245: 36580 IVDELE = IVDELE + 1 02420025
246: WRITE (I02,80003) IVTNUM 02430025
247: IF (ICZERO) 46580, 6591, 46580 02440025
248: 46580 IF ( IVCOMP - 3 ) 26580, 16580, 26580 02450025
249: 16580 IVPASS = IVPASS + 1 02460025
250: WRITE (I02,80001) IVTNUM 02470025
251: GO TO 6591 02480025
252: 26580 IVFAIL = IVFAIL + 1 02490025
253: IVCORR = 3 02500025
254: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02510025
255: 6591 CONTINUE 02520025
256: IVTNUM = 659 02530025
257: C 02540025
258: C **** TEST 659 **** 02550025
259: C TEST 659 - THIS TEST USES A TRIPLE NESTED DO LOOP TO SET THE 02560025
260: C ELEMENTS IN ALL THREE DIMENSIONS OF AN INTEGER ARRAY THAT IS 02570025
261: C DIMENSIONED. THE VALUES FOR THE ELEMENTS ARE AS FOLLOWS 02580025
262: C FOR ELEMENT (I,J,K) = I + J + K 02590025
263: C SO FOR ELEMENT (1,1,2) = 1 + 1 + 2 = 4 02600025
264: C 02610025
265: IF (ICZERO) 36590, 6590, 36590 02620025
266: 6590 CONTINUE 02630025
267: DO 6594 I = 1, 2 02640025
268: DO 6593 J = 1, 2 02650025
269: DO 6592 K = 1, 2 02660025
270: IADN32( I, J, K ) = I + J + K 02670025
271: 6592 CONTINUE 02680025
272: 6593 CONTINUE 02690025
273: 6594 CONTINUE 02700025
274: IVCOMP = IADN32(1,1,2) 02710025
275: GO TO 46590 02720025
276: 36590 IVDELE = IVDELE + 1 02730025
277: WRITE (I02,80003) IVTNUM 02740025
278: IF (ICZERO) 46590, 6601, 46590 02750025
279: 46590 IF ( IVCOMP - 4 ) 26590, 16590, 26590 02760025
280: 16590 IVPASS = IVPASS + 1 02770025
281: WRITE (I02,80001) IVTNUM 02780025
282: GO TO 6601 02790025
283: 26590 IVFAIL = IVFAIL + 1 02800025
284: IVCORR = 4 02810025
285: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02820025
286: 6601 CONTINUE 02830025
287: IVTNUM = 660 02840025
288: C 02850025
289: C **** TEST 660 **** 02860025
290: C TEST 660 - SEE TEST 659. THIS CHECKS FOR IADN32(2,2,2) = 6 02870025
291: C 02880025
292: IF (ICZERO) 36600, 6600, 36600 02890025
293: 6600 CONTINUE 02900025
294: IVCOMP = IADN32(2,2,2) 02910025
295: GO TO 46600 02920025
296: 36600 IVDELE = IVDELE + 1 02930025
297: WRITE (I02,80003) IVTNUM 02940025
298: IF (ICZERO) 46600, 6611, 46600 02950025
299: 46600 IF ( IVCOMP - 6 ) 26600, 16600, 26600 02960025
300: 16600 IVPASS = IVPASS + 1 02970025
301: WRITE (I02,80001) IVTNUM 02980025
302: GO TO 6611 02990025
303: 26600 IVFAIL = IVFAIL + 1 03000025
304: IVCORR = 6 03010025
305: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03020025
306: 6611 CONTINUE 03030025
307: IVTNUM = 661 03040025
308: C 03050025
309: C **** TEST 661 **** 03060025
310: C TEST 661 - THIS TEST SETS THE ELEMENTS OF AN INTEGER ARRAY IN 03070025
311: C COMMON TO MINUS THE VALUE OF THE INTEGER ARRAY SET IN TEST 659. 03080025
312: C ELEMENT IADN32(1,1,2) = 4 SO ELEMENT IADN31(1,1,2) = -4 03090025
313: C THE SAME INTEGER ASSIGNMENT STATEMENT IS USED AS THE TERMINATING 03100025
314: C STATEMENT FOR ALL THREE DO LOOPS USED TO SET THE ARRAY VALUES 03110025
315: C OF INTEGER ARRAY IADN31. 03120025
316: C IF TEST 659 FAILS, THEN THIS TEST SHOULD ALSO FAIL. HOWEVER, THE 03130025
317: C COMPUTED VALUES SHOULD RELATE IN THAT THE COMPUTED VALUE FOR 03140025
318: C TEST 661 SHOULD BE MINUS THE COMPUTED VALUE FOR TEST 659. 03150025
319: C 03160025
320: IF (ICZERO) 36610, 6610, 36610 03170025
321: 6610 CONTINUE 03180025
322: DO 6612 I = 1, 2 03190025
323: DO 6612 J = 1, 2 03200025
324: DO 6612 K = 1, 2 03210025
325: 6612 IADN31(I,J,K) = - IADN32 ( I, J, K ) 03220025
326: IVCOMP = IADN31(1,1,2) 03230025
327: GO TO 46610 03240025
328: 36610 IVDELE = IVDELE + 1 03250025
329: WRITE (I02,80003) IVTNUM 03260025
330: IF (ICZERO) 46610, 6621, 46610 03270025
331: 46610 IF ( IVCOMP + 4 ) 26610, 16610, 26610 03280025
332: 16610 IVPASS = IVPASS + 1 03290025
333: WRITE (I02,80001) IVTNUM 03300025
334: GO TO 6621 03310025
335: 26610 IVFAIL = IVFAIL + 1 03320025
336: IVCORR = -4 03330025
337: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03340025
338: 6621 CONTINUE 03350025
339: IVTNUM = 662 03360025
340: C 03370025
341: C **** TEST 662 **** 03380025
342: C TEST 662 - THIS IS A TEST OF A TRIPLE NESTED DO LOOP USED TO 03390025
343: C SET THE VALUES OF A LOGICAL ARRAY LADN31. UNLIKE THE OTHER TESTS 03400025
344: C THE THIRD DIMENSION IS SET LAST, THE FIRST DIMENSION IS SET SECOND03410025
345: C AND THE SECOND DIMENSION IS SET FIRST. ALL ARRAY ELEMENTS ARE SET03420025
346: C TO THE LOGICAL CONSTANT .FALSE. 03430025
347: C 03440025
348: IF (ICZERO) 36620, 6620, 36620 03450025
349: 6620 CONTINUE 03460025
350: DO 6622 K = 1, 2 03470025
351: DO 6622 I = 1, 2 03480025
352: DO 6622 J = 1, 2 03490025
353: LADN31( I, J, K ) = .FALSE. 03500025
354: 6622 CONTINUE 03510025
355: ICON01 = 1 03520025
356: IF ( LADN31(2,1,2) ) ICON01 = 0 03530025
357: GO TO 46620 03540025
358: 36620 IVDELE = IVDELE + 1 03550025
359: WRITE (I02,80003) IVTNUM 03560025
360: IF (ICZERO) 46620, 6631, 46620 03570025
361: 46620 IF ( ICON01 - 1 ) 26620, 16620, 26620 03580025
362: 16620 IVPASS = IVPASS + 1 03590025
363: WRITE (I02,80001) IVTNUM 03600025
364: GO TO 6631 03610025
365: 26620 IVFAIL = IVFAIL + 1 03620025
366: IVCOMP = ICON01 03630025
367: IVCORR = 1 03640025
368: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03650025
369: 6631 CONTINUE 03660025
370: IVTNUM = 663 03670025
371: C 03680025
372: C NOTE **** TEST 663 WAS DELETED BY FCCTS. 03690025
373: C 03700025
374: IF (ICZERO) 36630, 6630, 36630 03710025
375: 6630 CONTINUE 03720025
376: 36630 IVDELE = IVDELE + 1 03730025
377: WRITE (I02,80003) IVTNUM 03740025
378: IF (ICZERO) 46630, 6641, 46630 03750025
379: 46630 IF ( ICON01 - 6633 ) 26630, 16630, 26630 03760025
380: 16630 IVPASS = IVPASS + 1 03770025
381: WRITE (I02,80001) IVTNUM 03780025
382: GO TO 6641 03790025
383: 26630 IVFAIL = IVFAIL + 1 03800025
384: IVCOMP = ICON01 03810025
385: IVCORR = 6633 03820025
386: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03830025
387: 6641 CONTINUE 03840025
388: IVTNUM = 664 03850025
389: C 03860025
390: C NOTE **** TEST 664 WAS DELETED BY FCCTS. 03870025
391: C 03880025
392: IF (ICZERO) 36640, 6640, 36640 03890025
393: 6640 CONTINUE 03900025
394: 36640 IVDELE = IVDELE + 1 03910025
395: WRITE (I02,80003) IVTNUM 03920025
396: IF (ICZERO) 46640, 6651, 46640 03930025
397: 46640 IF ( ICON01 - 6643 ) 26640, 16640, 26640 03940025
398: 16640 IVPASS = IVPASS + 1 03950025
399: WRITE (I02,80001) IVTNUM 03960025
400: GO TO 6651 03970025
401: 26640 IVFAIL = IVFAIL + 1 03980025
402: IVCOMP = ICON01 03990025
403: IVCORR = 6443 04000025
404: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04010025
405: 6651 CONTINUE 04020025
406: IVTNUM = 665 04030025
407: C 04040025
408: C **** TEST 665 **** 04050025
409: C TEST 665 - ARRAY ELEMENTS SET TO TYPE REAL BY THE EXPLICIT 04060025
410: C REAL STATEMENT ARE SET TO THE VALUE 0.5 AND USED TO SET THE VALUE 04070025
411: C OF AN ARRAY ELEMENT SET TO TYPE INTEGER BY THE INTEGER STATEMENT. 04080025
412: C THIS LAST INTEGER ELEMENT IS USED IN A LOGICAL IF STATEMENT 04090025
413: C THAT SHOULD COMPARE TRUE. ( .5 + .5 + .5 ) * 2. .EQ. 3 04100025
414: C 04110025
415: IF (ICZERO) 36650, 6650, 36650 04120025
416: 6650 CONTINUE 04130025
417: IADN33(2,2,2) = 0.5 04140025
418: IADN22(2,4) = 0.5 04150025
419: IADN12(8) = 0.5 04160025
420: RADN11(8) = ( IADN33(2,2,2) + IADN22(2,4) + IADN12(8) ) * 2. 04170025
421: ICON01 = 0 04180025
422: IF ( RADN11(8) .EQ. 3 ) ICON01 = 1 04190025
423: GO TO 46650 04200025
424: 36650 IVDELE = IVDELE + 1 04210025
425: WRITE (I02,80003) IVTNUM 04220025
426: IF (ICZERO) 46650, 6661, 46650 04230025
427: 46650 IF ( ICON01 - 1 ) 26650, 16650, 26650 04240025
428: 16650 IVPASS = IVPASS + 1 04250025
429: WRITE (I02,80001) IVTNUM 04260025
430: GO TO 6661 04270025
431: 26650 IVFAIL = IVFAIL + 1 04280025
432: IVCOMP = ICON01 04290025
433: IVCORR = 1 04300025
434: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04310025
435: 6661 CONTINUE 04320025
436: C 04330025
437: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 04340025
438: 99999 CONTINUE 04350025
439: WRITE (I02,90002) 04360025
440: WRITE (I02,90006) 04370025
441: WRITE (I02,90002) 04380025
442: WRITE (I02,90002) 04390025
443: WRITE (I02,90007) 04400025
444: WRITE (I02,90002) 04410025
445: WRITE (I02,90008) IVFAIL 04420025
446: WRITE (I02,90009) IVPASS 04430025
447: WRITE (I02,90010) IVDELE 04440025
448: C 04450025
449: C 04460025
450: C TERMINATE ROUTINE EXECUTION 04470025
451: STOP 04480025
452: C 04490025
453: C FORMAT STATEMENTS FOR PAGE HEADERS 04500025
454: 90000 FORMAT (1H1) 04510025
455: 90002 FORMAT (1H ) 04520025
456: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04530025
457: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 04540025
458: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 04550025
459: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 04560025
460: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 04570025
461: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 04580025
462: C 04590025
463: C FORMAT STATEMENTS FOR RUN SUMMARIES 04600025
464: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 04610025
465: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 04620025
466: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 04630025
467: C 04640025
468: C FORMAT STATEMENTS FOR TEST RESULTS 04650025
469: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 04660025
470: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 04670025
471: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 04680025
472: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 04690025
473: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 04700025
474: C 04710025
475: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM025) 04720025
476: END 04730025
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.