![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM022.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 FM022.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. 00010022
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 00020022
6: C FM022 00030022
7: C 00040022
8: C THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS00050022
9: C SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT. THE VALUES 00060022
10: C OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE 00070022
11: C ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS 00080022
12: C (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO 00090022
13: C INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY 00100022
14: C USE OF THE EQUIVALENCE STATEMENT. 00110022
15: C 00120022
16: C REFERENCES 00130022
17: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140022
18: C X3.9-1978 00150022
19: C 00160022
20: C SECTION 8, SPECIFICATION STATEMENTS 00170022
21: C SECTION 8.1, DIMENSION STATEMENT 00180022
22: C SECTION 8.2, EQUIVALENCE STATEMENT 00190022
23: C SECTION 8.3, COMMON STATEMENT 00200022
24: C SECTION 8.4, TYPE-STATEMENTS 00210022
25: C SECTION 9, DATA STATEMENT 00220022
26: C 00230022
27: C 00240022
28: C 00250022
29: COMMON IADN14(5), RADN14(5), LADN13(2) 00260022
30: C 00270022
31: DIMENSION IADN11(5), RADN11(5), LADN11(2) 00280022
32: DIMENSION IADN12(5), RADN12(5), LADN12(2) 00290022
33: DIMENSION IADN15(2), RADN15(2) 00300022
34: DIMENSION IADN16(4), IADN17(4) 00310022
35: C 00320022
36: INTEGER RADN13(5) 00330022
37: REAL IADN13(5) 00340022
38: LOGICAL LADN11, LADN12, LADN13, LCTN01 00350022
39: C 00360022
40: EQUIVALENCE (IADN14(1), IADN15(1)), (RADN14(2),RADN15(2)) 00370022
41: EQUIVALENCE (LADN13(1),LCTN01), (IADN14(5), ICON02) 00380022
42: EQUIVALENCE (RADN14(5), RCON01) 00390022
43: EQUIVALENCE ( IADN16(3), IADN17(2) ) 00400022
44: C 00410022
45: DATA IADN12(1)/3/, RADN12(1)/-512./, IADN13(1)/0.5/, RADN13(1)/-3/00420022
46: C 00430022
47: C 00440022
48: C 00450022
49: C ********************************************************** 00460022
50: C 00470022
51: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00480022
52: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00490022
53: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00500022
54: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00510022
55: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00520022
56: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00530022
57: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00540022
58: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00550022
59: C OF EXECUTING THESE TESTS. 00560022
60: C 00570022
61: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00580022
62: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00590022
63: C 00600022
64: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00610022
65: C 00620022
66: C DEPARTMENT OF THE NAVY 00630022
67: C FEDERAL COBOL COMPILER TESTING SERVICE 00640022
68: C WASHINGTON, D.C. 20376 00650022
69: C 00660022
70: C ********************************************************** 00670022
71: C 00680022
72: C 00690022
73: C 00700022
74: C INITIALIZATION SECTION 00710022
75: C 00720022
76: C INITIALIZE CONSTANTS 00730022
77: C ************** 00740022
78: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00750022
79: I01 = 5 00760022
80: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00770022
81: I02 = 6 00780022
82: C SYSTEM ENVIRONMENT SECTION 00790022
83: C 00800022
84: I01 = 5 00810022
85: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00820022
86: C (UNIT NUMBER FOR CARD READER). 00830022
87: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00840022
88: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850022
89: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00860022
90: C 00870022
91: I02 = 6 00880022
92: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00890022
93: C (UNIT NUMBER FOR PRINTER). 00900022
94: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00910022
95: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00920022
96: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00930022
97: C 00940022
98: IVPASS=0 00950022
99: IVFAIL=0 00960022
100: IVDELE=0 00970022
101: ICZERO=0 00980022
102: C 00990022
103: C WRITE PAGE HEADERS 01000022
104: WRITE (I02,90000) 01010022
105: WRITE (I02,90001) 01020022
106: WRITE (I02,90002) 01030022
107: WRITE (I02, 90002) 01040022
108: WRITE (I02,90003) 01050022
109: WRITE (I02,90002) 01060022
110: WRITE (I02,90004) 01070022
111: WRITE (I02,90002) 01080022
112: WRITE (I02,90011) 01090022
113: WRITE (I02,90002) 01100022
114: WRITE (I02,90002) 01110022
115: WRITE (I02,90005) 01120022
116: WRITE (I02,90006) 01130022
117: WRITE (I02,90002) 01140022
118: IVTNUM = 604 01150022
119: C 01160022
120: C **** TEST 604 **** 01170022
121: C TEST 604 - THIS TESTS A SIMPLE ASSIGNMENT STATEMENT IN SETTING 01180022
122: C AN INTEGER ARRAY ELEMENT TO A POSITIVE VALUE OF 32767. 01190022
123: C 01200022
124: IF (ICZERO) 36040, 6040, 36040 01210022
125: 6040 CONTINUE 01220022
126: IADN11(5) = 32767 01230022
127: IVCOMP = IADN11(5) 01240022
128: GO TO 46040 01250022
129: 36040 IVDELE = IVDELE + 1 01260022
130: WRITE (I02,80003) IVTNUM 01270022
131: IF (ICZERO) 46040, 6051, 46040 01280022
132: 46040 IF ( IVCOMP - 32767 ) 26040, 16040, 26040 01290022
133: 16040 IVPASS = IVPASS + 1 01300022
134: WRITE (I02,80001) IVTNUM 01310022
135: GO TO 6051 01320022
136: 26040 IVFAIL = IVFAIL + 1 01330022
137: IVCORR = 32767 01340022
138: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01350022
139: 6051 CONTINUE 01360022
140: IVTNUM = 605 01370022
141: C 01380022
142: C **** TEST 605 **** 01390022
143: C TEST 605 - TEST OF A SIMPLE ASSIGN WITH A NEGATIVE VALUE -32766 01400022
144: C 01410022
145: IF (ICZERO) 36050, 6050, 36050 01420022
146: 6050 CONTINUE 01430022
147: IADN11(1) = -32766 01440022
148: IVCOMP = IADN11(1) 01450022
149: GO TO 46050 01460022
150: 36050 IVDELE = IVDELE + 1 01470022
151: WRITE (I02,80003) IVTNUM 01480022
152: IF (ICZERO) 46050, 6061, 46050 01490022
153: 46050 IF ( IVCOMP + 32766 ) 26050, 16050, 26050 01500022
154: 16050 IVPASS = IVPASS + 1 01510022
155: WRITE (I02,80001) IVTNUM 01520022
156: GO TO 6061 01530022
157: 26050 IVFAIL = IVFAIL + 1 01540022
158: IVCORR = -32766 01550022
159: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01560022
160: 6061 CONTINUE 01570022
161: IVTNUM = 606 01580022
162: C 01590022
163: C **** TEST 606 **** 01600022
164: C TEST 606 - TEST OF UNSIGNED ZERO SET TO AN ARRAY ELEMENT 01610022
165: C BY A SIMPLE ASSIGNMENT STATEMENT. 01620022
166: C 01630022
167: IF (ICZERO) 36060, 6060, 36060 01640022
168: 6060 CONTINUE 01650022
169: IADN11(3) = 0 01660022
170: IVCOMP = IADN11(3) 01670022
171: GO TO 46060 01680022
172: 36060 IVDELE = IVDELE + 1 01690022
173: WRITE (I02,80003) IVTNUM 01700022
174: IF (ICZERO) 46060, 6071, 46060 01710022
175: 46060 IF ( IVCOMP - 0 ) 26060, 16060, 26060 01720022
176: 16060 IVPASS = IVPASS + 1 01730022
177: WRITE (I02,80001) IVTNUM 01740022
178: GO TO 6071 01750022
179: 26060 IVFAIL = IVFAIL + 1 01760022
180: IVCORR = 0 01770022
181: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01780022
182: 6071 CONTINUE 01790022
183: IVTNUM = 607 01800022
184: C 01810022
185: C **** TEST 607 **** 01820022
186: C TEST 607 - TEST OF A NEGATIVELY SIGNED ZERO COMPARED TO A 01830022
187: C ZERO UNSIGNED BOTH VALUES SET AS INTEGER ARRAY ELEMENTS. 01840022
188: C 01850022
189: IF (ICZERO) 36070, 6070, 36070 01860022
190: 6070 CONTINUE 01870022
191: IADN11(2) = -0 01880022
192: IADN11(3) = 0 01890022
193: ICON01 = 0 01900022
194: IF ( IADN11(2) .EQ. IADN11(3) ) ICON01 = 1 01910022
195: GO TO 46070 01920022
196: 36070 IVDELE = IVDELE + 1 01930022
197: WRITE (I02,80003) IVTNUM 01940022
198: IF (ICZERO) 46070, 6081, 46070 01950022
199: 46070 IF ( ICON01 - 1 ) 26070, 16070, 26070 01960022
200: 16070 IVPASS = IVPASS + 1 01970022
201: WRITE (I02,80001) IVTNUM 01980022
202: GO TO 6081 01990022
203: 26070 IVFAIL = IVFAIL + 1 02000022
204: IVCOMP = ICON01 02010022
205: IVCORR = 1 02020022
206: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02030022
207: 6081 CONTINUE 02040022
208: IVTNUM = 608 02050022
209: C 02060022
210: C **** TEST 608 **** 02070022
211: C TEST 608 - TEST OF SETTING ONE INTEGER ARRAY ELEMENT EQUAL TO 02080022
212: C THE VALUE OF ANOTHER INTEGER ARRAY ELEMENT. THE VALUE IS 32767. 02090022
213: C 02100022
214: IF (ICZERO) 36080, 6080, 36080 02110022
215: 6080 CONTINUE 02120022
216: IADN11(1) = 32767 02130022
217: IADN12(5) = IADN11(1) 02140022
218: IVCOMP = IADN12(5) 02150022
219: GO TO 46080 02160022
220: 36080 IVDELE = IVDELE + 1 02170022
221: WRITE (I02,80003) IVTNUM 02180022
222: IF (ICZERO) 46080, 6091, 46080 02190022
223: 46080 IF ( IVCOMP - 32767 ) 26080, 16080, 26080 02200022
224: 16080 IVPASS = IVPASS + 1 02210022
225: WRITE (I02,80001) IVTNUM 02220022
226: GO TO 6091 02230022
227: 26080 IVFAIL = IVFAIL + 1 02240022
228: IVCORR = 32767 02250022
229: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02260022
230: 6091 CONTINUE 02270022
231: IVTNUM = 609 02280022
232: C 02290022
233: C **** TEST 609 **** 02300022
234: C TEST 609 - TEST OF AN ARRAY ELEMENT SET TO ANOTHER ARRAY ELEMENT02310022
235: C WHICH HAD BEEN SET AT COMPILE TIME BY A DATA INITIALIZATION 02320022
236: C STATEMENT. AN INTEGER ARRAY IS USED WITH THE VALUE 3. 02330022
237: C 02340022
238: IF (ICZERO) 36090, 6090, 36090 02350022
239: 6090 CONTINUE 02360022
240: IADN11(4) = IADN12(1) 02370022
241: IVCOMP = IADN11(4) 02380022
242: GO TO 46090 02390022
243: 36090 IVDELE = IVDELE + 1 02400022
244: WRITE (I02,80003) IVTNUM 02410022
245: IF (ICZERO) 46090, 6101, 46090 02420022
246: 46090 IF ( IVCOMP - 3 ) 26090, 16090, 26090 02430022
247: 16090 IVPASS = IVPASS + 1 02440022
248: WRITE (I02,80001) IVTNUM 02450022
249: GO TO 6101 02460022
250: 26090 IVFAIL = IVFAIL + 1 02470022
251: IVCORR = 3 02480022
252: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02490022
253: 6101 CONTINUE 02500022
254: IVTNUM = 610 02510022
255: C 02520022
256: C **** TEST 610 **** 02530022
257: C TEST 610 - TEST OF SETTING A REAL ARRAY ELEMENT TO A POSITIVE 02540022
258: C VALUE IN A SIMPLE ASSIGNMENT STATEMENT. VALUE IS 32767. 02550022
259: C 02560022
260: IF (ICZERO) 36100, 6100, 36100 02570022
261: 6100 CONTINUE 02580022
262: RADN11(5) = 32767. 02590022
263: IVCOMP = RADN11(5) 02600022
264: GO TO 46100 02610022
265: 36100 IVDELE = IVDELE + 1 02620022
266: WRITE (I02,80003) IVTNUM 02630022
267: IF (ICZERO) 46100, 6111, 46100 02640022
268: 46100 IF ( IVCOMP - 32767 ) 26100, 16100, 26100 02650022
269: 16100 IVPASS = IVPASS + 1 02660022
270: WRITE (I02,80001) IVTNUM 02670022
271: GO TO 6111 02680022
272: 26100 IVFAIL = IVFAIL + 1 02690022
273: IVCORR = 32767 02700022
274: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02710022
275: 6111 CONTINUE 02720022
276: IVTNUM = 611 02730022
277: C 02740022
278: C **** TEST 611 **** 02750022
279: C TEST 611 - TEST OF SETTING A REAL ARRAY ELEMENT TO A NEGATIVE 02760022
280: C VALUE IN A SIMPLE ASSIGNMENT STATEMENT. VALUE IS -32766. 02770022
281: C 02780022
282: IF (ICZERO) 36110, 6110, 36110 02790022
283: 6110 CONTINUE 02800022
284: RADN11(1) = -32766. 02810022
285: IVCOMP = RADN11(1) 02820022
286: GO TO 46110 02830022
287: 36110 IVDELE = IVDELE + 1 02840022
288: WRITE (I02,80003) IVTNUM 02850022
289: IF (ICZERO) 46110, 6121, 46110 02860022
290: 46110 IF ( IVCOMP + 32766 ) 26110, 16110, 26110 02870022
291: 16110 IVPASS = IVPASS + 1 02880022
292: WRITE (I02,80001) IVTNUM 02890022
293: GO TO 6121 02900022
294: 26110 IVFAIL = IVFAIL + 1 02910022
295: IVCORR = -32766 02920022
296: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02930022
297: 6121 CONTINUE 02940022
298: IVTNUM = 612 02950022
299: C 02960022
300: C **** TEST 612 **** 02970022
301: C TEST 612 - TEST OF SETTING A REAL ARRAY ELEMENT TO UNSIGNED ZERO02980022
302: C IN A SIMPLE ASSIGNMENT STATEMENT. 02990022
303: C 03000022
304: IF (ICZERO) 36120, 6120, 36120 03010022
305: 6120 CONTINUE 03020022
306: RADN11(3) = 0. 03030022
307: IVCOMP = RADN11(3) 03040022
308: GO TO 46120 03050022
309: 36120 IVDELE = IVDELE + 1 03060022
310: WRITE (I02,80003) IVTNUM 03070022
311: IF (ICZERO) 46120, 6131, 46120 03080022
312: 46120 IF ( IVCOMP - 0 ) 26120, 16120, 26120 03090022
313: 16120 IVPASS = IVPASS + 1 03100022
314: WRITE (I02,80001) IVTNUM 03110022
315: GO TO 6131 03120022
316: 26120 IVFAIL = IVFAIL + 1 03130022
317: IVCORR = 0 03140022
318: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03150022
319: 6131 CONTINUE 03160022
320: IVTNUM = 613 03170022
321: C 03180022
322: C **** TEST 613 **** 03190022
323: C TEST 613 - TEST OF A NEGATIVELY SIGNED ZERO IN A REAL ARRAY 03200022
324: C ELEMENT COMPARED TO A REAL ELEMENT SET TO AN UNSIGNED ZERO. 03210022
325: C 03220022
326: IF (ICZERO) 36130, 6130, 36130 03230022
327: 6130 CONTINUE 03240022
328: RADN11(2) = -0.0 03250022
329: RADN11(3) = 0.0 03260022
330: ICON01 = 0 03270022
331: IF ( RADN11(2) .EQ. RADN11(3) ) ICON01 = 1 03280022
332: GO TO 46130 03290022
333: 36130 IVDELE = IVDELE + 1 03300022
334: WRITE (I02,80003) IVTNUM 03310022
335: IF (ICZERO) 46130, 6141, 46130 03320022
336: 46130 IF ( ICON01 - 1 ) 26130, 16130, 26130 03330022
337: 16130 IVPASS = IVPASS + 1 03340022
338: WRITE (I02,80001) IVTNUM 03350022
339: GO TO 6141 03360022
340: 26130 IVFAIL = IVFAIL + 1 03370022
341: IVCOMP = ICON01 03380022
342: IVCORR = 1 03390022
343: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03400022
344: 6141 CONTINUE 03410022
345: IVTNUM = 614 03420022
346: C 03430022
347: C **** TEST 614 **** 03440022
348: C TEST 614 - TEST OF SETTING ONE REAL ARRAY ELEMENT EQUAL TO THE 03450022
349: C VALUE OF ANOTHER REAL ARRAY ELEMENT. THE VALUE IS 32767. 03460022
350: C 03470022
351: IF (ICZERO) 36140, 6140, 36140 03480022
352: 6140 CONTINUE 03490022
353: RADN11(1) = 32767. 03500022
354: RADN12(5) = RADN11(1) 03510022
355: IVCOMP = RADN12(5) 03520022
356: GO TO 46140 03530022
357: 36140 IVDELE = IVDELE + 1 03540022
358: WRITE (I02,80003) IVTNUM 03550022
359: IF (ICZERO) 46140, 6151, 46140 03560022
360: 46140 IF ( IVCOMP - 32767 ) 26140, 16140, 26140 03570022
361: 16140 IVPASS = IVPASS + 1 03580022
362: WRITE (I02,80001) IVTNUM 03590022
363: GO TO 6151 03600022
364: 26140 IVFAIL = IVFAIL + 1 03610022
365: IVCORR = 32767 03620022
366: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03630022
367: 6151 CONTINUE 03640022
368: IVTNUM = 615 03650022
369: C 03660022
370: C **** TEST 615 **** 03670022
371: C TEST 615 - TEST OF A REAL ARRAY ELEMENT SET TO ANOTHER REAL 03680022
372: C ARRAY ELEMENT WHICH HAD BEEN SET AT COMPILE TIME BY A DATA 03690022
373: C INITIALIZATION STATEMENT. THE VALUE IS -512. 03700022
374: C 03710022
375: IF (ICZERO) 36150, 6150, 36150 03720022
376: 6150 CONTINUE 03730022
377: RADN11(4) = RADN12(1) 03740022
378: IVCOMP = RADN11(4) 03750022
379: GO TO 46150 03760022
380: 36150 IVDELE = IVDELE + 1 03770022
381: WRITE (I02,80003) IVTNUM 03780022
382: IF (ICZERO) 46150, 6161, 46150 03790022
383: 46150 IF ( IVCOMP + 512 ) 26150, 16150, 26150 03800022
384: 16150 IVPASS = IVPASS + 1 03810022
385: WRITE (I02,80001) IVTNUM 03820022
386: GO TO 6161 03830022
387: 26150 IVFAIL = IVFAIL + 1 03840022
388: IVCORR = - 512 03850022
389: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03860022
390: 6161 CONTINUE 03870022
391: IVTNUM = 616 03880022
392: C 03890022
393: C **** TEST 616 **** 03900022
394: C TEST 616 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT03910022
395: C BY AN ARITHMETIC EXPRESSION. 03920022
396: C 03930022
397: IF (ICZERO) 36160, 6160, 36160 03940022
398: 6160 CONTINUE 03950022
399: ICON01 = 1 03960022
400: IADN11(3) = ICON01 + 1 03970022
401: IVCOMP = IADN11(3) 03980022
402: GO TO 46160 03990022
403: 36160 IVDELE = IVDELE + 1 04000022
404: WRITE (I02,80003) IVTNUM 04010022
405: IF (ICZERO) 46160, 6171, 46160 04020022
406: 46160 IF ( IVCOMP - 2 ) 26160, 16160, 26160 04030022
407: 16160 IVPASS = IVPASS + 1 04040022
408: WRITE (I02,80001) IVTNUM 04050022
409: GO TO 6171 04060022
410: 26160 IVFAIL = IVFAIL + 1 04070022
411: IVCORR = 2 04080022
412: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04090022
413: 6171 CONTINUE 04100022
414: IVTNUM = 617 04110022
415: C 04120022
416: C **** TEST 617 **** 04130022
417: C TEST 617 - TEST OF SETTING THE VALUE OF A REAL ARRAY ELEMENT 04140022
418: C BY AN ARITHMETIC EXPRESSION. 04150022
419: C 04160022
420: IF (ICZERO) 36170, 6170, 36170 04170022
421: 6170 CONTINUE 04180022
422: RCON01 = 1. 04190022
423: RADN11(3) = RCON01 + 1. 04200022
424: IVCOMP = RADN11(3) 04210022
425: GO TO 46170 04220022
426: 36170 IVDELE = IVDELE + 1 04230022
427: WRITE (I02,80003) IVTNUM 04240022
428: IF (ICZERO) 46170, 6181, 46170 04250022
429: 46170 IF ( IVCOMP - 2 ) 26170, 16170, 26170 04260022
430: 16170 IVPASS = IVPASS + 1 04270022
431: WRITE (I02,80001) IVTNUM 04280022
432: GO TO 6181 04290022
433: 26170 IVFAIL = IVFAIL + 1 04300022
434: IVCORR = 2 04310022
435: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04320022
436: 6181 CONTINUE 04330022
437: IVTNUM = 618 04340022
438: C 04350022
439: C **** TEST 618 **** 04360022
440: C TEST 618 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT04370022
441: C TO ANOTHER INTEGER ARRAY ELEMENT AND CHANGING THE SIGN. 04380022
442: C 04390022
443: IF (ICZERO) 36180, 6180, 36180 04400022
444: 6180 CONTINUE 04410022
445: IADN11(2) = 32766 04420022
446: IADN11(4) = - IADN11(2) 04430022
447: IVCOMP = IADN11(4) 04440022
448: GO TO 46180 04450022
449: 36180 IVDELE = IVDELE + 1 04460022
450: WRITE (I02,80003) IVTNUM 04470022
451: IF (ICZERO) 46180, 6191, 46180 04480022
452: 46180 IF ( IVCOMP + 32766 ) 26180, 16180, 26180 04490022
453: 16180 IVPASS = IVPASS + 1 04500022
454: WRITE (I02,80001) IVTNUM 04510022
455: GO TO 6191 04520022
456: 26180 IVFAIL = IVFAIL + 1 04530022
457: IVCORR = -32766 04540022
458: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04550022
459: 6191 CONTINUE 04560022
460: IVTNUM = 619 04570022
461: C 04580022
462: C **** TEST 619 **** 04590022
463: C TEST 619 - TEST OF SETTING THE VALUE OF A REAL ARRAY ELEMENT 04600022
464: C TO THE VALUE OF ANOTHER REAL ARRAY ELEMENT AND CHANGING THE SIGN. 04610022
465: C 04620022
466: IF (ICZERO) 36190, 6190, 36190 04630022
467: 6190 CONTINUE 04640022
468: RADN11(2) = 32766. 04650022
469: RADN11(4) = - RADN11(2) 04660022
470: IVCOMP = RADN11(4) 04670022
471: GO TO 46190 04680022
472: 36190 IVDELE = IVDELE + 1 04690022
473: WRITE (I02,80003) IVTNUM 04700022
474: IF (ICZERO) 46190, 6201, 46190 04710022
475: 46190 IF ( IVCOMP + 32766 ) 26190, 16190, 26190 04720022
476: 16190 IVPASS = IVPASS + 1 04730022
477: WRITE (I02,80001) IVTNUM 04740022
478: GO TO 6201 04750022
479: 26190 IVFAIL = IVFAIL + 1 04760022
480: IVCORR = -32766 04770022
481: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04780022
482: 6201 CONTINUE 04790022
483: IVTNUM = 620 04800022
484: C 04810022
485: C **** TEST 620 **** 04820022
486: C TEST 620 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 04830022
487: C TO THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT. 04840022
488: C 04850022
489: IF (ICZERO) 36200, 6200, 36200 04860022
490: 6200 CONTINUE 04870022
491: LADN11(1) = .TRUE. 04880022
492: LADN12(1) = LADN11(1) 04890022
493: ICON01 = 0 04900022
494: IF ( LADN12(1) ) ICON01 = 1 04910022
495: GO TO 46200 04920022
496: 36200 IVDELE = IVDELE + 1 04930022
497: WRITE (I02,80003) IVTNUM 04940022
498: IF (ICZERO) 46200, 6211, 46200 04950022
499: 46200 IF ( ICON01 - 1 ) 26200, 16200, 26200 04960022
500: 16200 IVPASS = IVPASS + 1 04970022
501: WRITE (I02,80001) IVTNUM 04980022
502: GO TO 6211 04990022
503: 26200 IVFAIL = IVFAIL + 1 05000022
504: IVCOMP = ICON01 05010022
505: IVCORR = 1 05020022
506: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05030022
507: 6211 CONTINUE 05040022
508: IVTNUM = 621 05050022
509: C 05060022
510: C **** TEST 621 **** 05070022
511: C TEST 621 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 05080022
512: C TO THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT AND CHANGING 05090022
513: C THE VALUE FROM .TRUE. TO .FALSE. BY USING THE .NOT. STATEMENT. 05100022
514: C 05110022
515: IF (ICZERO) 36210, 6210, 36210 05120022
516: 6210 CONTINUE 05130022
517: LADN11(2) = .TRUE. 05140022
518: LADN12(2) = .NOT. LADN11(2) 05150022
519: ICON01 = 1 05160022
520: IF ( LADN12(2) ) ICON01 = 0 05170022
521: GO TO 46210 05180022
522: 36210 IVDELE = IVDELE + 1 05190022
523: WRITE (I02,80003) IVTNUM 05200022
524: IF (ICZERO) 46210, 6221, 46210 05210022
525: 46210 IF ( ICON01 - 1 ) 26210, 16210, 26210 05220022
526: 16210 IVPASS = IVPASS + 1 05230022
527: WRITE (I02,80001) IVTNUM 05240022
528: GO TO 6221 05250022
529: 26210 IVFAIL = IVFAIL + 1 05260022
530: IVCOMP = ICON01 05270022
531: IVCORR = 1 05280022
532: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05290022
533: 6221 CONTINUE 05300022
534: IVTNUM = 622 05310022
535: C 05320022
536: C **** TEST 622 **** 05330022
537: C TEST 622 - TEST OF THE TYPE STATEMENT AND THE DATA 05340022
538: C INITIALIZATION STATEMENT. THE EXPLICITLY REAL ARRAY ELEMENT 05350022
539: C SHOULD HAVE THE VALUE OF .5 05360022
540: C 05370022
541: IF (ICZERO) 36220, 6220, 36220 05380022
542: 6220 CONTINUE 05390022
543: IVCOMP = 2. * IADN13(1) 05400022
544: GO TO 46220 05410022
545: 36220 IVDELE = IVDELE + 1 05420022
546: WRITE (I02,80003) IVTNUM 05430022
547: IF (ICZERO) 46220, 6231, 46220 05440022
548: 46220 IF ( IVCOMP - 1 ) 26220, 16220, 26220 05450022
549: 16220 IVPASS = IVPASS + 1 05460022
550: WRITE (I02,80001) IVTNUM 05470022
551: GO TO 6231 05480022
552: 26220 IVFAIL = IVFAIL + 1 05490022
553: IVCORR = 1 05500022
554: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05510022
555: 6231 CONTINUE 05520022
556: IVTNUM = 623 05530022
557: C 05540022
558: C **** TEST 623 **** 05550022
559: C TEST 623 - TEST OF REAL TO INTEGER CONVERSION USING ARRAYS. 05560022
560: C THE INITIALIZED VALUE OF 0.5 SHOULD BE TRUNCATED TO ZERO. 05570022
561: C 05580022
562: IF (ICZERO) 36230, 6230, 36230 05590022
563: 6230 CONTINUE 05600022
564: IADN11(1) = IADN13(1) 05610022
565: IVCOMP = IADN11(1) 05620022
566: GO TO 46230 05630022
567: 36230 IVDELE = IVDELE + 1 05640022
568: WRITE (I02,80003) IVTNUM 05650022
569: IF (ICZERO) 46230, 6241, 46230 05660022
570: 46230 IF ( IVCOMP - 0 ) 26230, 16230, 26230 05670022
571: 16230 IVPASS = IVPASS + 1 05680022
572: WRITE (I02,80001) IVTNUM 05690022
573: GO TO 6241 05700022
574: 26230 IVFAIL = IVFAIL + 1 05710022
575: IVCORR = 0 05720022
576: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05730022
577: 6241 CONTINUE 05740022
578: IVTNUM = 624 05750022
579: C 05760022
580: C **** TEST 624 **** 05770022
581: C TEST 624 - TEST OF THE COMMON STATEMENT BY SETTING THE VALUE OF 05780022
582: C AN INTEGER ARRAY ELEMENT IN A DIMENSIONED ARRAY TO THE VALUE 05790022
583: C OF A REAL ARRAY ELEMENT IN COMMON. THE ELEMENT IN COMMON HAD ITS 05800022
584: C VALUE SET IN A SIMPLE ASSIGNMENT STATEMENT TO 9999. 05810022
585: C 05820022
586: IF (ICZERO) 36240, 6240, 36240 05830022
587: 6240 CONTINUE 05840022
588: RADN14(1) = 9999. 05850022
589: IADN11(1) = RADN14(1) 05860022
590: IVCOMP = IADN11(1) 05870022
591: GO TO 46240 05880022
592: 36240 IVDELE = IVDELE + 1 05890022
593: WRITE (I02,80003) IVTNUM 05900022
594: IF (ICZERO) 46240, 6251, 46240 05910022
595: 46240 IF ( IVCOMP - 9999 ) 26240, 16240, 26240 05920022
596: 16240 IVPASS = IVPASS + 1 05930022
597: WRITE (I02,80001) IVTNUM 05940022
598: GO TO 6251 05950022
599: 26240 IVFAIL = IVFAIL + 1 05960022
600: IVCORR = 9999 05970022
601: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05980022
602: 6251 CONTINUE 05990022
603: IVTNUM = 625 06000022
604: C 06010022
605: C **** TEST 625 **** 06020022
606: C TEST 625 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT06030022
607: C IN COMMON TO THE VALUE OF A REAL ARRAY ELEMENT ALSO IN BLANK 06040022
608: C COMMON AND CHANGING THE SIGN. THE VALUE USED IS 9999. 06050022
609: C 06060022
610: IF (ICZERO) 36250, 6250, 36250 06070022
611: 6250 CONTINUE 06080022
612: RADN14(1) = 9999. 06090022
613: IADN14(1) = - RADN14(1) 06100022
614: IVCOMP = IADN14(1) 06110022
615: GO TO 46250 06120022
616: 36250 IVDELE = IVDELE + 1 06130022
617: WRITE (I02,80003) IVTNUM 06140022
618: IF (ICZERO) 46250, 6261, 46250 06150022
619: 46250 IF ( IVCOMP + 9999 ) 26250, 16250, 26250 06160022
620: 16250 IVPASS = IVPASS + 1 06170022
621: WRITE (I02,80001) IVTNUM 06180022
622: GO TO 6261 06190022
623: 26250 IVFAIL = IVFAIL + 1 06200022
624: IVCORR = - 9999 06210022
625: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06220022
626: 6261 CONTINUE 06230022
627: IVTNUM = 626 06240022
628: C 06250022
629: C **** TEST 626 **** 06260022
630: C TEST 626 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 06270022
631: C IN BLANK COMMON TO .NOT. .TRUE. 06280022
632: C THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT ALSO IN COMMON IS THEN 06290022
633: C SET TO .NOT. OF THE VALUE OF THE FIRST. 06300022
634: C VALUE OF THE FIRST ELEMENT SHOULD BE .FALSE. 06310022
635: C VALUE OF THE SECOND ELEMENT SHOULD BE .TRUE. 06320022
636: C 06330022
637: IF (ICZERO) 36260, 6260, 36260 06340022
638: 6260 CONTINUE 06350022
639: LADN13(1) = .NOT. .TRUE. 06360022
640: LADN13(2) = .NOT. LADN13(1) 06370022
641: ICON01 = 0 06380022
642: IF ( LADN13(2) ) ICON01 = 1 06390022
643: GO TO 46260 06400022
644: 36260 IVDELE = IVDELE + 1 06410022
645: WRITE (I02,80003) IVTNUM 06420022
646: IF (ICZERO) 46260, 6271, 46260 06430022
647: 46260 IF ( ICON01 - 1 ) 26260, 16260, 26260 06440022
648: 16260 IVPASS = IVPASS + 1 06450022
649: WRITE (I02,80001) IVTNUM 06460022
650: GO TO 6271 06470022
651: 26260 IVFAIL = IVFAIL + 1 06480022
652: IVCOMP = ICON01 06490022
653: IVCORR = 1 06500022
654: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06510022
655: 6271 CONTINUE 06520022
656: IVTNUM = 627 06530022
657: C 06540022
658: C **** TEST 627 **** 06550022
659: C TEST 627 - TEST OF EQUIVALENCE ON THE FIRST ELEMENTS OF INTEGER 06560022
660: C ARRAYS ONE OF WHICH IS IN COMMON AND THE OTHER ONE IS DIMENSIONED.06570022
661: C 06580022
662: IF (ICZERO) 36270, 6270, 36270 06590022
663: 6270 CONTINUE 06600022
664: IADN14(2) = 32767 06610022
665: IVCOMP = IADN15(2) 06620022
666: GO TO 46270 06630022
667: 36270 IVDELE = IVDELE + 1 06640022
668: WRITE (I02,80003) IVTNUM 06650022
669: IF (ICZERO) 46270, 6281, 46270 06660022
670: 46270 IF ( IVCOMP - 32767 ) 26270, 16270, 26270 06670022
671: 16270 IVPASS = IVPASS + 1 06680022
672: WRITE (I02,80001) IVTNUM 06690022
673: GO TO 6281 06700022
674: 26270 IVFAIL = IVFAIL + 1 06710022
675: IVCORR = 32767 06720022
676: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06730022
677: 6281 CONTINUE 06740022
678: IVTNUM = 628 06750022
679: C 06760022
680: C **** TEST 628 **** 06770022
681: C TEST 628 - TEST OF EQUIVALENCE ON REAL ARRAYS ONE OF WHICH IS 06780022
682: C IN COMMON AND THE OTHER ONE IS DIMENSIONED. THE ARRAYS WERE 06790022
683: C ALIGNED ON THEIR SECOND ELEMENTS. 06800022
684: C 06810022
685: IF (ICZERO) 36280, 6280, 36280 06820022
686: 6280 CONTINUE 06830022
687: RADN15(1) = -32766. 06840022
688: IVCOMP = RADN14(1) 06850022
689: GO TO 46280 06860022
690: 36280 IVDELE = IVDELE + 1 06870022
691: WRITE (I02,80003) IVTNUM 06880022
692: IF (ICZERO) 46280, 6291, 46280 06890022
693: 46280 IF ( IVCOMP + 32766 ) 26280, 16280, 26280 06900022
694: 16280 IVPASS = IVPASS + 1 06910022
695: WRITE (I02,80001) IVTNUM 06920022
696: GO TO 6291 06930022
697: 26280 IVFAIL = IVFAIL + 1 06940022
698: IVCORR = -32766 06950022
699: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06960022
700: 6291 CONTINUE 06970022
701: IVTNUM = 629 06980022
702: C 06990022
703: C **** TEST 629 **** 07000022
704: C TEST 629 - TEST OF EQUIVALENCE WITH LOGICAL ELEMENTS. AN ARRAY 07010022
705: C ELEMENT IN COMMON IS EQUIVALENCED TO A LOGICAL VARIABLE. 07020022
706: C 07030022
707: IF (ICZERO) 36290, 6290, 36290 07040022
708: 6290 CONTINUE 07050022
709: LADN13(2) = .TRUE. 07060022
710: LCTN01 = .NOT. LADN13(2) 07070022
711: ICON01 = 1 07080022
712: IF ( LADN13(1) ) ICON01 = 0 07090022
713: GO TO 46290 07100022
714: 36290 IVDELE = IVDELE + 1 07110022
715: WRITE (I02,80003) IVTNUM 07120022
716: IF (ICZERO) 46290, 6301, 46290 07130022
717: 46290 IF ( ICON01 - 1 ) 26290, 16290, 26290 07140022
718: 16290 IVPASS = IVPASS + 1 07150022
719: WRITE (I02,80001) IVTNUM 07160022
720: GO TO 6301 07170022
721: 26290 IVFAIL = IVFAIL + 1 07180022
722: IVCOMP = ICON01 07190022
723: IVCORR = 1 07200022
724: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07210022
725: 6301 CONTINUE 07220022
726: IVTNUM = 630 07230022
727: C 07240022
728: C **** TEST 630 **** 07250022
729: C TEST 630 - TEST OF EQUIVALENCE WITH REAL AND INTEGER ELEMENTS 07260022
730: C WHICH ARE EQUIVALENCED TO ARRAY ELEMENTS IN COMMON. 07270022
731: C 07280022
732: IF (ICZERO) 36300, 6300, 36300 07290022
733: 6300 CONTINUE 07300022
734: RCON01 = 1. 07310022
735: ICON02 = - RADN14(5) 07320022
736: IVCOMP = IADN14(5) 07330022
737: GO TO 46300 07340022
738: 36300 IVDELE = IVDELE + 1 07350022
739: WRITE (I02,80003) IVTNUM 07360022
740: IF (ICZERO) 46300, 6311, 46300 07370022
741: 46300 IF ( IVCOMP + 1 ) 26300, 16300, 26300 07380022
742: 16300 IVPASS = IVPASS + 1 07390022
743: WRITE (I02,80001) IVTNUM 07400022
744: GO TO 6311 07410022
745: 26300 IVFAIL = IVFAIL + 1 07420022
746: IVCORR = -1 07430022
747: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07440022
748: 6311 CONTINUE 07450022
749: IVTNUM = 631 07460022
750: C 07470022
751: C **** TEST 631 **** 07480022
752: C TEST 631 - TEST OF EQUIVALENCE ON INTEGER ARRAY ELEMENTS. 07490022
753: C BOTH ARRAYS ARE DIMENSIONED. THE FOURTH ELEMENT 07500022
754: C OF THE FIRST OF THE ARRAYS SHOULD BE EQUAL TO THE THIRD ELEMENT OF07510022
755: C THE SECOND ARRAY. 07520022
756: C 07530022
757: IF (ICZERO) 36310, 6310, 36310 07540022
758: 6310 CONTINUE 07550022
759: IADN16(4) = 9999 07560022
760: IVCOMP = IADN17(3) 07570022
761: GO TO 46310 07580022
762: 36310 IVDELE = IVDELE + 1 07590022
763: WRITE (I02,80003) IVTNUM 07600022
764: IF (ICZERO) 46310, 6321, 46310 07610022
765: 46310 IF ( IVCOMP - 9999 ) 26310, 16310, 26310 07620022
766: 16310 IVPASS = IVPASS + 1 07630022
767: WRITE (I02,80001) IVTNUM 07640022
768: GO TO 6321 07650022
769: 26310 IVFAIL = IVFAIL + 1 07660022
770: IVCORR = 9999 07670022
771: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07680022
772: 6321 CONTINUE 07690022
773: C 07700022
774: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07710022
775: 99999 CONTINUE 07720022
776: WRITE (I02,90002) 07730022
777: WRITE (I02,90006) 07740022
778: WRITE (I02,90002) 07750022
779: WRITE (I02,90002) 07760022
780: WRITE (I02,90007) 07770022
781: WRITE (I02,90002) 07780022
782: WRITE (I02,90008) IVFAIL 07790022
783: WRITE (I02,90009) IVPASS 07800022
784: WRITE (I02,90010) IVDELE 07810022
785: C 07820022
786: C 07830022
787: C TERMINATE ROUTINE EXECUTION 07840022
788: STOP 07850022
789: C 07860022
790: C FORMAT STATEMENTS FOR PAGE HEADERS 07870022
791: 90000 FORMAT (1H1) 07880022
792: 90002 FORMAT (1H ) 07890022
793: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 07900022
794: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 07910022
795: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 07920022
796: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 07930022
797: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 07940022
798: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 07950022
799: C 07960022
800: C FORMAT STATEMENTS FOR RUN SUMMARIES 07970022
801: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 07980022
802: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 07990022
803: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 08000022
804: C 08010022
805: C FORMAT STATEMENTS FOR TEST RESULTS 08020022
806: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 08030022
807: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 08040022
808: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 08050022
809: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 08060022
810: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 08070022
811: C 08080022
812: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM022) 08090022
813: END 08100022
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.