![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM080.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 FM080.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 00010080
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 00020080
6: C FM080 00030080
7: C 00040080
8: C THIS ROUTINE CONTAINS EXTERNAL FUNCTION REFERENCE TESTS. 00050080
9: C THE FUNCTION SUBPROGRAMS CALLED BY THIS ROUTINE ARE FF081, 00060080
10: C FF082 AND FF083. THE FUNCTION SUBPROGRAMS ARE DEFINED AS 00070080
11: C FF081 = INTEGER, FF082 = REAL, FF083 = IMPLICIT REAL. 00080080
12: C THE FUNCTION SUBPROGRAM DUMMY ARGUMENTS MUST AGREE IN ORDER, 00090080
13: C NUMBER AND TYPE WITH THE CORRESPONDING ACTUAL ARGUMENTS OF THE 00100080
14: C MAIN PROGRAM. THE ARGUMENTS OF THE FUNCTION SUBPROGRAMS WILL 00110080
15: C CORRESPOND TO ACTUAL ARGUMENT LIST REFERENCES OF VARIABLE-NAME, 00120080
16: C ARRAY-NAME, ARRAY-ELEMENT-NAME AND EXPRESSION RESPECTIVELY. 00130080
17: C 00140080
18: C THIS ROUTINE WILL TEST THE VALUE OF THE FUNCTION AND THE 00150080
19: C FUNCTION ARGUMENTS RETURNED FOLLOWING THE FUNCTION REFERENCE CALL.00160080
20: C 00170080
21: C 00180080
22: C REFERENCES 00190080
23: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00200080
24: C X3.9-1978 00210080
25: C 00220080
26: C SECTION 2.6, ARRAY 00230080
27: C SECTION 15.5.2, REFERENCING EXTERNAL FUNCTIONS 00240080
28: C SECTION 17.2, EVENTS THAT CAUSE ENTITIES TO BECOME DEFINED 00250080
29: DIMENSION IADN1A (5), IADN2A (4,4) 00260080
30: DIMENSION RADN3A (3,6,3), RADN1A (10) 00270080
31: DIMENSION IADN3A (3,4,5) 00280080
32: INTEGER FF081 00290080
33: REAL FF082 00300080
34: C 00310080
35: C ********************************************************** 00320080
36: C 00330080
37: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00340080
38: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00350080
39: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00360080
40: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00370080
41: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00380080
42: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00390080
43: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00400080
44: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00410080
45: C OF EXECUTING THESE TESTS. 00420080
46: C 00430080
47: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00440080
48: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00450080
49: C 00460080
50: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00470080
51: C 00480080
52: C DEPARTMENT OF THE NAVY 00490080
53: C FEDERAL COBOL COMPILER TESTING SERVICE 00500080
54: C WASHINGTON, D.C. 20376 00510080
55: C 00520080
56: C ********************************************************** 00530080
57: C 00540080
58: C 00550080
59: C 00560080
60: C INITIALIZATION SECTION 00570080
61: C 00580080
62: C INITIALIZE CONSTANTS 00590080
63: C ************** 00600080
64: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00610080
65: I01 = 5 00620080
66: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00630080
67: I02 = 6 00640080
68: C SYSTEM ENVIRONMENT SECTION 00650080
69: C 00660080
70: I01 = 5 00670080
71: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680080
72: C (UNIT NUMBER FOR CARD READER). 00690080
73: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00700080
74: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00710080
75: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00720080
76: C 00730080
77: I02 = 6 00740080
78: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00750080
79: C (UNIT NUMBER FOR PRINTER). 00760080
80: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00770080
81: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00780080
82: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00790080
83: C 00800080
84: IVPASS=0 00810080
85: IVFAIL=0 00820080
86: IVDELE=0 00830080
87: ICZERO=0 00840080
88: C 00850080
89: C WRITE PAGE HEADERS 00860080
90: WRITE (I02,90000) 00870080
91: WRITE (I02,90001) 00880080
92: WRITE (I02,90002) 00890080
93: WRITE (I02, 90002) 00900080
94: WRITE (I02,90003) 00910080
95: WRITE (I02,90002) 00920080
96: WRITE (I02,90004) 00930080
97: WRITE (I02,90002) 00940080
98: WRITE (I02,90011) 00950080
99: WRITE (I02,90002) 00960080
100: WRITE (I02,90002) 00970080
101: WRITE (I02,90005) 00980080
102: WRITE (I02,90006) 00990080
103: WRITE (I02,90002) 01000080
104: C 01010080
105: C TEST SECTION 01020080
106: C 01030080
107: C EXTERNAL FUNCTION REFERENCE - FUNCTION SUBPROGRAM DEFINED AS 01040080
108: C INTEGER (FF081) 01050080
109: C 01060080
110: 6741 CONTINUE 01070080
111: IVTNUM = 674 01080080
112: C 01090080
113: C TEST 674 THROUGH 679 TEST THE FUNCTION AND ARGUMENT VALUES 01100080
114: C FROM REFERENCE OF FUNCTION FF081. FUNCTION SUBPROGRAM FF081 IS 01110080
115: C DEFINED AS INTEGER. 01120080
116: C 01130080
117: C **** TEST 674 **** 01140080
118: C 01150080
119: C TEST 674 TESTS THE FUNCTION VALUE RETURNED FROM FUNCTION FF081 01160080
120: C 01170080
121: IF (ICZERO) 36740,6740,36740 01180080
122: 6740 CONTINUE 01190080
123: IVON0A = 0 01200080
124: IVON02 = 2 01210080
125: IADN1A (3) = 8 01220080
126: IADN1A (2) = 4 01230080
127: IADN2A (1,3) =10 01240080
128: IVON0A = FF081 (IVON02, IADN1A, IADN2A, 999) 01250080
129: GO TO 46740 01260080
130: 36740 IVDELE = IVDELE + 1 01270080
131: WRITE (I02,80003) IVTNUM 01280080
132: IF (ICZERO) 46740,6751,46740 01290080
133: 46740 IF (IVON0A - 1015) 26740,16740,26740 01300080
134: 16740 IVPASS = IVPASS + 1 01310080
135: WRITE (I02,80001) IVTNUM 01320080
136: GO TO 6751 01330080
137: 26740 IVFAIL = IVFAIL + 1 01340080
138: IVCORR = 1015 01350080
139: IVCOMP = IVON0A 01360080
140: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01370080
141: 6751 CONTINUE 01380080
142: IVTNUM = 675 01390080
143: C 01400080
144: C **** TEST 675 **** 01410080
145: C 01420080
146: C TEST 675 TESTS THE RETURN VALUE OF VARIABLE-NAME ARGUMENT 01430080
147: C IVON02. VALUE OF IVON02 SHOULD BE 4. 01440080
148: C 01450080
149: IF (ICZERO) 36750,6750,36750 01460080
150: 6750 CONTINUE 01470080
151: GO TO 46750 01480080
152: 36750 IVDELE = IVDELE + 1 01490080
153: WRITE (I02,80003) IVTNUM 01500080
154: IF (ICZERO) 46750,6761,46750 01510080
155: 46750 IF (IVON02 - 4) 26750,16750,26750 01520080
156: 16750 IVPASS = IVPASS + 1 01530080
157: WRITE (I02,80001) IVTNUM 01540080
158: GO TO 6761 01550080
159: 26750 IVFAIL = IVFAIL + 1 01560080
160: IVCORR = 4 01570080
161: IVCOMP = IVON02 01580080
162: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01590080
163: 6761 CONTINUE 01600080
164: IVTNUM = 676 01610080
165: C 01620080
166: C **** TEST 676 **** 01630080
167: C 01640080
168: C TEST 676 TESTS THE RETURN VALUE OF ARRAY-NAME ARGUMENT 01650080
169: C IADN1A. IADN1A (2) IS INCREMENTED BY 40 IN FUNCTION SUBPROGRAM 01660080
170: C AND SHOULD RETURN A VALUE OF 44. 01670080
171: C 01680080
172: IF (ICZERO) 36760,6760,36760 01690080
173: 6760 CONTINUE 01700080
174: GO TO 46760 01710080
175: 36760 IVDELE = IVDELE + 1 01720080
176: WRITE (I02,80003) IVTNUM 01730080
177: IF (ICZERO) 46760,6771,46760 01740080
178: 46760 IF (IADN1A (2) - 44) 26760,16760,26760 01750080
179: 16760 IVPASS = IVPASS + 1 01760080
180: WRITE (I02,80001) IVTNUM 01770080
181: GO TO 6771 01780080
182: 26760 IVFAIL = IVFAIL + 1 01790080
183: IVCORR = 44 01800080
184: IVCOMP = IADN1A (2) 01810080
185: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01820080
186: 6771 CONTINUE 01830080
187: IVTNUM = 677 01840080
188: C 01850080
189: C **** TEST 677 **** 01860080
190: C 01870080
191: C TEST 677 TESTS THE RETURN VALUE OF ARRAY-NAME ARGUMENT IADN1A. 01880080
192: C IADN1A (3) WAS NOT MODIFFED BY FUNCTION SUBPROGRAM AND SHOULD 01890080
193: C HAVE A VALUE OF 8 01900080
194: C 01910080
195: IF (ICZERO) 36770,6770,36770 01920080
196: 6770 CONTINUE 01930080
197: GO TO 46770 01940080
198: 36770 IVDELE = IVDELE + 1 01950080
199: WRITE (I02,80003) IVTNUM 01960080
200: IF (ICZERO) 46770,6781,46770 01970080
201: 46770 IF (IADN1A (3) - 8) 26770,16770,26770 01980080
202: 16770 IVPASS = IVPASS + 1 01990080
203: WRITE (I02,80001) IVTNUM 02000080
204: GO TO 6781 02010080
205: 26770 IVFAIL = IVFAIL + 1 02020080
206: IVCORR = 8 02030080
207: IVCOMP = IADN1A (3) 02040080
208: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02050080
209: 6781 CONTINUE 02060080
210: IVTNUM = 678 02070080
211: C 02080080
212: C **** TEST 678 **** 02090080
213: C 02100080
214: C TEST 678 TESTS THE RETURN VALUE OF ARRAY-ELEMENT-NAME 02110080
215: C IADN2A (1,3). IADN2A (1,3) WAS INCREMENTED BY 70 IN THE FUNCTION 02120080
216: C SUBPROGRAM AND SHOULD CONTAIN A VALUE OF 80. 02130080
217: C 02140080
218: IF (ICZERO) 36780,6780,36780 02150080
219: 6780 CONTINUE 02160080
220: GO TO 46780 02170080
221: 36780 IVDELE = IVDELE + 1 02180080
222: WRITE (I02,80003) IVTNUM 02190080
223: IF (ICZERO) 46780,6791,46780 02200080
224: 46780 IF (IADN2A (1,3) - 80) 26780,16780,26780 02210080
225: 16780 IVPASS = IVPASS + 1 02220080
226: WRITE (I02,80001) IVTNUM 02230080
227: GO TO 6791 02240080
228: 26780 IVFAIL = IVFAIL + 1 02250080
229: IVCORR = 80 02260080
230: IVCOMP = IADN2A (1,3) 02270080
231: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02280080
232: 6791 CONTINUE 02290080
233: IVTNUM = 679 02300080
234: C 02310080
235: C **** TEST 679 **** 02320080
236: C 02330080
237: C TEST 679 TESTS THE VALUE OF INTEGER FUNCTION ASSIGNED 02340080
238: C TO A REAL VARIABLE. 02350080
239: C 02360080
240: IF (ICZERO) 36790,6790,36790 02370080
241: 6790 CONTINUE 02380080
242: RVON0A = 0.0 02390080
243: IVON02 = 2 02400080
244: IADN1A (2) = 4 02410080
245: IADN2A (1,3) = 10 02420080
246: RVON0A = FF081 (IVON02, IADN1A, IADN2A, 999) 02430080
247: GO TO 46790 02440080
248: 36790 IVDELE = IVDELE + 1 02450080
249: WRITE (I02,80003) IVTNUM 02460080
250: IF (ICZERO) 46790,6801,46790 02470080
251: 46790 IF (RVON0A - 1014.5) 26790,16790,46791 02480080
252: 46791 IF (RVON0A - 1015.5) 16790,16790,26790 02490080
253: 16790 IVPASS = IVPASS + 1 02500080
254: WRITE (I02,80001) IVTNUM 02510080
255: GO TO 6801 02520080
256: 26790 IVFAIL = IVFAIL + 1 02530080
257: RVCORR = 1015.0 02540080
258: RVCOMP = RVON0A 02550080
259: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02560080
260: 6801 CONTINUE 02570080
261: IVTNUM = 680 02580080
262: C 02590080
263: C EXTERNAL FUNCTION REFERENCE - FUNCTION SUBPROGRAM FF082 DEFINED AS02600080
264: C REAL 02610080
265: C 02620080
266: C TESTS 680 THRU 685 TESTS THE FUNCTION AND ARGUMENT VALUES 02630080
267: C FROM THE FUNCTION REFERENCE TO SUBPROGRAM FF082. THE FUNCTION 02640080
268: C SUBPROGRAM IS DEFINED AS REAL. 02650080
269: C 02660080
270: C **** TEST 680 *** 02670080
271: C 02680080
272: C TEST 680 TESTS THE VALUE OF THE FUNCTION FF082. VALUE OF 02690080
273: C FUNCTION SHOULD BE 339.0. 02700080
274: C 02710080
275: IF (ICZERO) 36800,6800,36800 02720080
276: 6800 CONTINUE 02730080
277: RVON01 = 2.0 02740080
278: RADN3A (2,5,2) = 100.0 02750080
279: RADN1A (5) = 210.5 02760080
280: RVON0A = 0.0 02770080
281: RVON0A = FF082 (RVON01, RADN3A, RADN1A, 26.5) 02780080
282: GO TO 46800 02790080
283: 36800 IVDELE = IVDELE + 1 02800080
284: WRITE (I02, 80003) IVTNUM 02810080
285: IF (ICZERO) 46800,6811,46800 02820080
286: 46800 IF (RVON0A - 338.5) 26800,16800,46801 02830080
287: 46801 IF (RVON0A - 339.5) 16800,16800,26800 02840080
288: 16800 IVPASS = IVPASS + 1 02850080
289: WRITE (I02,80001) IVTNUM 02860080
290: GO TO 6811 02870080
291: 26800 IVFAIL = IVFAIL + 1 02880080
292: RVCORR = 339.0 02890080
293: RVCOMP = RVON0A 02900080
294: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02910080
295: 6811 CONTINUE 02920080
296: IVTNUM = 681 02930080
297: C 02940080
298: C **** TEST 681 **** 02950080
299: C 02960080
300: C TEST 681 TESTS THE VALUE OF THE VARIABLE-NAME ARGUMENT RVON01 02970080
301: C FOLLOWING THE FUNCTION REFERENCE. VALUE OF RVON01 SHOULD BE 8.4. 02980080
302: C 02990080
303: IF (ICZERO) 36810,6810,36810 03000080
304: 6810 CONTINUE 03010080
305: GO TO 46810 03020080
306: 36810 IVDELE = IVDELE + 1 03030080
307: WRITE (I02,80003) IVTNUM 03040080
308: IF (ICZERO) 46810,6821,46810 03050080
309: 46810 IF (RVON01 - 8.395) 26810,16810,46811 03060080
310: 46811 IF (RVON01 - 8.405) 16810,16810,26810 03070080
311: 16810 IVPASS = IVPASS + 1 03080080
312: WRITE (I02,80001) IVTNUM 03090080
313: GO TO 6821 03100080
314: 26810 IVFAIL = IVFAIL + 1 03110080
315: RVCORR = 8.4 03120080
316: RVCOMP = RVON01 03130080
317: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03140080
318: 6821 CONTINUE 03150080
319: IVTNUM = 682 03160080
320: C 03170080
321: C **** TEST 682 **** 03180080
322: C 03190080
323: C TEST 682 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT RADN3A 03200080
324: C FOLLOWING THE FUNCTION REFERENCE. RADN3A (2,5,2) WAS INITIALIZED 03210080
325: C IN MAIN PROGRAM AND INCREMENTED IN SUBPROGRAM. VALUE OF RADN3A 03220080
326: C (2,5,2) SHOULD BE 112.2. 03230080
327: C 03240080
328: IF (ICZERO) 36820,6820,36820 03250080
329: 6820 CONTINUE 03260080
330: GO TO 46820 03270080
331: 36820 IVDELE = IVDELE + 1 03280080
332: WRITE (I02,80003) IVTNUM 03290080
333: IF (ICZERO) 46820,6831,46820 03300080
334: 46820 IF (RADN3A (2,5,2) - 111.7) 26820,16820,46821 03310080
335: 46821 IF (RADN3A (2,5,2) - 112.7) 16820,16820,26820 03320080
336: 16820 IVPASS = IVPASS + 1 03330080
337: WRITE (I02,80001) IVTNUM 03340080
338: GO TO 6831 03350080
339: 26820 IVFAIL = IVFAIL + 1 03360080
340: RVCORR = 112.2 03370080
341: RVCOMP = RADN3A (2,5,2) 03380080
342: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03390080
343: 6831 CONTINUE 03400080
344: IVTNUM = 683 03410080
345: C 03420080
346: C **** TEST 683 **** 03430080
347: C 03440080
348: C TEST 683 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT RADN3A 03450080
349: C FOLLOWING THE FUNCTION REFERENCE. RADN3A (1,2,1) WAS INITIALIZED 03460080
350: C IN THE SUBPROGRAM. THE VALUE OF RADN3A (1,2,1) SHOULD BE 612.2. 03470080
351: C 03480080
352: IF (ICZERO) 36830,6830,36830 03490080
353: 6830 CONTINUE 03500080
354: GO TO 46830 03510080
355: 36830 IVDELE = IVDELE + 1 03520080
356: WRITE (I02,80003) IVTNUM 03530080
357: IF (ICZERO) 46830,6841,46830 03540080
358: 46830 IF (RADN3A (1,2,1) - 611.7) 26830,16830,46831 03550080
359: 46831 IF (RADN3A (1,2,1) - 612.7) 16830,16830,26830 03560080
360: 16830 IVPASS = IVPASS + 1 03570080
361: WRITE (I02,80001) IVTNUM 03580080
362: GO TO 6841 03590080
363: 26830 IVFAIL = IVFAIL + 1 03600080
364: RVCORR = 612.2 03610080
365: RVCOMP = RADN3A (1,2,1) 03620080
366: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03630080
367: 6841 CONTINUE 03640080
368: IVTNUM = 684 03650080
369: C 03660080
370: C **** TEST 684 **** 03670080
371: C 03680080
372: C TEST 684 TESTS THE VALUE OF THE ARRAY-ELEMENT-NAME ARGUMENT 03690080
373: C RADN1A FOLLOWING THE FUNCTION REFERENCE. RADN1A (5) WAS 03700080
374: C INITIALIZED IN THE MAIN PROGRAM AND INCREMENTED BY 18.8 IN THE 03710080
375: C FUNCTION SUBPROGRAM. THE VALUE OF RADN1A SHOULD BE 229.3. 03720080
376: C 03730080
377: IF (ICZERO) 36840,6840,36840 03740080
378: 6840 CONTINUE 03750080
379: GO TO 46840 03760080
380: 36840 IVDELE = IVDELE + 1 03770080
381: WRITE (I02,80003) IVTNUM 03780080
382: IF (ICZERO) 46840,6851,46840 03790080
383: 46840 IF (RADN1A (5) - 228.8) 26840,16840,46841 03800080
384: 46841 IF (RADN1A (5) - 229.8) 16840,16840,26840 03810080
385: 16840 IVPASS = IVPASS + 1 03820080
386: WRITE (I02,80001) IVTNUM 03830080
387: GO TO 6851 03840080
388: 26840 IVFAIL = IVFAIL + 1 03850080
389: RVCORR = 229.3 03860080
390: RVCOMP = RADN1A (5) 03870080
391: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03880080
392: 6851 CONTINUE 03890080
393: IVTNUM = 685 03900080
394: C 03910080
395: C **** TEST 685 **** 03920080
396: C 03930080
397: C TEST 685 TESTS THE RESULTANT VALUE WHERE THE FUNCTION 03940080
398: C SUBPROGRAM IS DEFINED AS REAL AND THE VARIABLE TO WHICH THE 03950080
399: C FUNCTION VALUE IS ASSIGNED IN THE MAIN PROGRAM IS DEFINED AS 03960080
400: C INTEGER. 03970080
401: C 03980080
402: IF (ICZERO) 36850,6850,36850 03990080
403: 6850 CONTINUE 04000080
404: RVON01 = 4.0 04010080
405: RADN3A (2,5,2) = 200.0 04020080
406: RADN1A (5) = 2.85 04030080
407: IVON0A = 0.0 04040080
408: IVON0A = FF082 (RVON01, RADN3A, RADN1A, 102.68) 04050080
409: GO TO 46850 04060080
410: 36850 IVDELE = IVDELE + 1 04070080
411: WRITE (I02,80003) IVTNUM 04080080
412: IF (ICZERO) 46850,6861,46850 04090080
413: 46850 IF (IVON0A - 309) 26850,16850,26850 04100080
414: 16850 IVPASS = IVPASS + 1 04110080
415: WRITE (I02,80001) IVTNUM 04120080
416: GO TO 6861 04130080
417: 26850 IVFAIL = IVFAIL + 1 04140080
418: IVCORR = 309 04150080
419: IVCOMP = IVON0A 04160080
420: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04170080
421: 6861 CONTINUE 04180080
422: IVTNUM = 686 04190080
423: C 04200080
424: C TESTS 686 THRU 690 TESTS THE FUNCTION AND ARGUMENT VALUES 04210080
425: C FROM THE EXTERNAL FUNCTION REFERENCE TO SUBPROGRAM FF083. THE 04220080
426: C FUNCTION SUBPROGRAM IS AN IMPLICIT DEFINITION OF REAL. 04230080
427: C 04240080
428: C ***** TEST 686 ***** 04250080
429: C 04260080
430: C TEST 686 TESTS THE VALUE OF FUNCTION FF082. THE VALUE OF THE 04270080
431: C FUNCTION SHOULD BE 921.8. 04280080
432: C 04290080
433: IF (ICZERO) 36860,6860,36860 04300080
434: 6860 CONTINUE 04310080
435: C 04320080
436: C 04330080
437: IVON01 = 826 04340080
438: IADN2A (1,1) = 77 04350080
439: IADN3A (2,3,4) = 10 04360080
440: RVON02 = 4.4 04370080
441: RVON03 = 0.0 04380080
442: C 04390080
443: RVON03 = FF083 (IVON01, IADN2A, IADN3A, RVON02 * 2.0) 04400080
444: GO TO 46860 04410080
445: 36860 IVDELE = IVDELE + 1 04420080
446: WRITE (I02,80003) IVTNUM 04430080
447: IF (ICZERO) 46860,6871,46860 04440080
448: 46860 IF (RVON03 - 921.3) 26860,16860,46861 04450080
449: 46861 IF (RVON03 - 922.3) 16860,16860,26860 04460080
450: 16860 IVPASS = IVPASS + 1 04470080
451: WRITE (I02,80001) IVTNUM 04480080
452: GO TO 6871 04490080
453: 26860 IVFAIL = IVFAIL + 1 04500080
454: RVCORR = 921.8 04510080
455: RVCOMP = RVON03 04520080
456: WRITE (I02,80005) IVTNUM, RVCOMP, IVCORR 04530080
457: 6871 CONTINUE 04540080
458: IVTNUM = 687 04550080
459: C 04560080
460: C **** TEST 687 ***** 04570080
461: C 04580080
462: C TEST 687 TESTS THE VALUE OF THE VARIABLE-NAME ARGUMENT IVON01 04590080
463: C FOLLOWING THE FUNCTION REFERENCE. THE VALUE OF IVON01 SHOULD BE 04600080
464: C 836. 04610080
465: C 04620080
466: IF (ICZERO) 36870,6870,36870 04630080
467: 6870 CONTINUE 04640080
468: GO TO 46870 04650080
469: 36870 IVDELE = IVDELE + 1 04660080
470: WRITE (I02,80003) IVTNUM 04670080
471: IF (ICZERO) 46870,6881,46870 04680080
472: 46870 IF (IVON01 - 836) 26870,16870,26870 04690080
473: 16870 IVPASS = IVPASS + 1 04700080
474: WRITE (I02,80001) IVTNUM 04710080
475: GO TO 6881 04720080
476: 26870 IVFAIL = IVFAIL + 1 04730080
477: IVCORR = 836 04740080
478: IVCOMP = IVON01 04750080
479: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04760080
480: 6881 CONTINUE 04770080
481: IVTNUM = 688 04780080
482: C 04790080
483: C **** TEST 688 ***** 04800080
484: C 04810080
485: C TEST 688 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT IADN2A 04820080
486: C FOLLOWING THE FUNCTION REFERENCE. THE ACTUAL ARGUMENT WAS 04830080
487: C INITIALIZED IN THE MAIN PROGRAM AND IS INCREMENTED IN THE 04840080
488: C SUBPROGRAM. THE VALUE OF IADN2A (1,1) SHOULD BE 97. 04850080
489: C 04860080
490: IF (ICZERO) 36880,6880,36880 04870080
491: 6880 CONTINUE 04880080
492: GO TO 46880 04890080
493: 36880 IVDELE = IVDELE + 1 04900080
494: WRITE (I02,80003) IVTNUM 04910080
495: IF (ICZERO) 46880,6880,46880 04920080
496: 46880 IF (IADN2A (1,1) - 97) 26880,16880,26880 04930080
497: 16880 IVPASS = IVPASS + 1 04940080
498: WRITE (I02,80001) IVTNUM 04950080
499: GO TO 6891 04960080
500: 26880 IVFAIL = IVFAIL + 1 04970080
501: IVCORR = 97 04980080
502: IVCOMP = IADN2A (1,1) 04990080
503: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05000080
504: 6891 CONTINUE 05010080
505: IVTNUM = 689 05020080
506: C 05030080
507: C **** TEST 689 **** 05040080
508: C 05050080
509: C TEST 689 TESTS THE VALUE OF THE ARRAY-ELEMENT-NAME ARGUMENT 05060080
510: C IADN3A FOLLOWING THE FUNCTION REFERENCE. IADN3A (2,3,4) 05070080
511: C WAS INTIALIZED IN THE MAIN PROGRAM AND INCREMENTED BY 40 IN THE 05080080
512: C FUNCTION SUBPROGRAM. THE VALUE OF IADN3A SHOULD BE 50. 05090080
513: C 05100080
514: IF (ICZERO) 36890,6890,36890 05110080
515: 6890 CONTINUE 05120080
516: GO TO 46890 05130080
517: 36890 IVDELE = IVDELE + 1 05140080
518: WRITE (I02,80003) IVTNUM 05150080
519: IF (ICZERO) 46890,6901,46890 05160080
520: 46890 IF (IADN3A (2,3,4) - 50) 26890,16890,26890 05170080
521: 16890 IVPASS = IVPASS + 1 05180080
522: WRITE (I02,80001) IVTNUM 05190080
523: GO TO 6901 05200080
524: 26890 IVFAIL = IVFAIL + 1 05210080
525: IVCORR = 50 05220080
526: IVCOMP = IADN3A (2,3,4) 05230080
527: WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 05240080
528: 6901 CONTINUE 05250080
529: IVTNUM = 690 05260080
530: C 05270080
531: C **** TEST 690 **** 05280080
532: C 05290080
533: C TEST 690 TESTS THE RESULTANT VALUE WHERE THE FUNCTION 05300080
534: C SUBPROGRAM IS IMPLICITY DEFINED AS REAL AND THE VARIABLE 05310080
535: C TO WHICH THE FUNCTION VALUE IS ASSIGNED IN THE MAIN PROGRAM 05320080
536: C IS DEFINED AS INTEGER. THE VALUE OF IVON03 SHOULD BE 329. 05330080
537: C 05340080
538: IF (ICZERO) 36900,6900,36900 05350080
539: 6900 CONTINUE 05360080
540: IVON01 = 226 05370080
541: IADN2A (1,1) = 66 05380080
542: IADN3A (2,3,4) = 20 05390080
543: RVON02 = 8.8 05400080
544: IVON03 = 0 05410080
545: C 05420080
546: IVON03 = FF083 (IVON01,IADN2A,IADN3A,RVON02 * 2.0) 05430080
547: C 05440080
548: GO TO 46900 05450080
549: 36900 IVDELE = IVDELE + 1 05460080
550: WRITE (I02,80003) IVTNUM 05470080
551: IF (ICZERO) 46900,6911,46900 05480080
552: 46900 IF (IVON03 - 329) 26900,16900,26900 05490080
553: 16900 IVPASS = IVPASS + 1 05500080
554: WRITE (I02,80001) IVTNUM 05510080
555: GO TO 6911 05520080
556: 26900 IVFAIL = IVFAIL + 1 05530080
557: IVCORR = 329 05540080
558: IVCOMP = IVON03 05550080
559: WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05560080
560: 6911 CONTINUE 05570080
561: C 05580080
562: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 05590080
563: 99999 CONTINUE 05600080
564: WRITE (I02,90002) 05610080
565: WRITE (I02,90006) 05620080
566: WRITE (I02,90002) 05630080
567: WRITE (I02,90002) 05640080
568: WRITE (I02,90007) 05650080
569: WRITE (I02,90002) 05660080
570: WRITE (I02,90008) IVFAIL 05670080
571: WRITE (I02,90009) IVPASS 05680080
572: WRITE (I02,90010) IVDELE 05690080
573: C 05700080
574: C 05710080
575: C TERMINATE ROUTINE EXECUTION 05720080
576: STOP 05730080
577: C 05740080
578: C FORMAT STATEMENTS FOR PAGE HEADERS 05750080
579: 90000 FORMAT (1H1) 05760080
580: 90002 FORMAT (1H ) 05770080
581: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 05780080
582: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 05790080
583: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 05800080
584: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 05810080
585: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 05820080
586: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 05830080
587: C 05840080
588: C FORMAT STATEMENTS FOR RUN SUMMARIES 05850080
589: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 05860080
590: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 05870080
591: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 05880080
592: C 05890080
593: C FORMAT STATEMENTS FOR TEST RESULTS 05900080
594: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 05910080
595: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 05920080
596: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 05930080
597: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 05940080
598: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 05950080
599: C 05960080
600: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM080) 05970080
601: END 05980080
602: INTEGER FUNCTION FF081 (IDON01, IDDN10, IDDN20, IDON02) 00010081
603: C DATE***82/08/02*18.33.46
604: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
605: C AUDIT FCVS78 V2.0
606: C 00020081
607: C COMMENT SECTION 00030081
608: C 00040081
609: C FF081 00050081
610: C 00060081
611: C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080. 00070081
612: C THE FUNCTION DUMMY ARGUMENTS IDON01, IDDN10 AND IDDN20 ARE 00080081
613: C INCREMENTED BY 2, 40 AND 70 RESPECTIVELY BEFORE CONTROL IS 00090081
614: C RETURNED TO THE CALLING PROGRAM. VALUE OF THE FUNCTION WILL BE 00100081
615: C THE SUM OF THE ACTUAL ARGUMENTS AS PASSED FROM CALLING PROGRAM. 00110081
616: C 00120081
617: C REFERENCES 00130081
618: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140081
619: C X3.9-1978 00150081
620: C 00160081
621: C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00170081
622: C 00180081
623: C TEST SECTION 00190081
624: C 00200081
625: C FUNCTION SUBPROGRAM 00210081
626: C 00220081
627: DIMENSION IDDN10 (5), IDDN20 (4,4) 00230081
628: IVON01 = IDON01 00240081
629: IVON02 = IDDN10(2) 00250081
630: IVON03 = IDDN20(1,3) 00260081
631: IVON04 = IDON02 00270081
632: C 00280081
633: FF081 = IVON01 + IVON02 + IVON03 + IVON04 00290081
634: IDON01 = IVON01 + 2 00300081
635: IDDN10 (2) = IVON02 + 40 00310081
636: IDDN20 (1,3) = IVON03 + 70 00320081
637: IDDN10 (4) = IVON02 + 40 00330081
638: RETURN 00340081
639: END 00350081
640: REAL FUNCTION FF082 (RDON01, RDDN3A, RDDN1A, RDON02) 00010082
641: C DATE***82/08/02*18.33.46
642: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
643: C AUDIT FCVS78 V2.0
644: DIMENSION RDDN3A (3,6,3), RDDN1A (10) 00020082
645: C 00030082
646: C COMMENT SECTION 00040082
647: C 00050082
648: C FF082 00060082
649: C 00070082
650: C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080. 00080082
651: C THE FUNCTION DUMMY ARGUMENTS RDON01, RDDN3A, AND RDDN1A ARE 00090082
652: C INCREMENTED BY 6.4, 12.2 AND 18.8 RESPECTIVELY BEFORE CONTROL IS 00100082
653: C RETURNED TO THE MAIN PROGRAM. VALUE OF THE FUNCTION WILL BE 00110082
654: C THE SUM OF THE ACTUAL ARGUMENTS AS PASSED TO THE SUBPROGRAM. 00120082
655: C 00130082
656: C REFERENCES 00140082
657: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150082
658: C X3.9-1978 00160082
659: C 00170082
660: C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00180082
661: C 00190082
662: C TEST SECTION 00200082
663: C 00210082
664: C FUNCTION SUBPROGRAM 00220082
665: C 00230082
666: RVON01 = RDON01 00240082
667: RVON02 = RDDN3A (2,5,2) 00250082
668: RVON03 = RDDN1A (5) 00260082
669: RVON04 = RDON02 00270082
670: C 00280082
671: FF082 = RVON01 + RVON02 + RVON03 + RVON04 00290082
672: C 00300082
673: RDON01 = RVON01 + 6.4 00310082
674: RDDN3A (2,5,2) = RVON02 + 12.2 00320082
675: RDDN1A (5) = RVON03 + 18.8 00330082
676: RDDN3A (1,2,1) = 600.0 + 12.2 00340082
677: RETURN 00350082
678: END 00360082
679: FUNCTION FF083 (IDON01,IDDN2A,IDDN3A,RDON02) 00010083
680: C DATE***82/08/02*18.33.46
681: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
682: C AUDIT FCVS78 V2.0
683: DIMENSION IDDN2A (2,2), IDDN3A(3,4,5) 00020083
684: C 00030083
685: C COMMENT SECTION 00040083
686: C 00050083
687: C FF083 00060083
688: C 00070083
689: C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080. 00080083
690: C THE TYPE DECLARATION IS IMPLICIT REAL. 00090083
691: C THE FUNCTION DUMMY ARGUMENTS ARE BOTH INTEGER AND REAL. DUMMY 00100083
692: C ARGUMENTS IDON01, IDDN2A AND IDDN3A ARE INCREMENTED BY 10, 20 AND 00110083
693: C 40 RESPECTIVELY BEFORE CONTROL IS RETURNED TO THE MAIN PROGRAM. 00120083
694: C THE VALUE OF THE FUNCTION RETURNED TO THE REFERENCING PROGRAM 00130083
695: C WILL BE THE SUM OF THE ACTUAL ARGUMENTS AS PASSED TO THE 00140083
696: C SUBPROGRAM FF083. 00150083
697: C DUMMY ARGUMENT IDDN2A CORRESPONDS TO AN ARRAY-NAME IN THE 00160083
698: C ACTUAL ARGUMENT OF THE MAIN PROGRAM. DUMMY ARGUMENT IDDN3A 00170083
699: C CORRESPONDS TO AN ARRAY-ELEMENT-NAME IN THE ACTUAL ARGUMENT OF THE00180083
700: C MAIN PROGRAM. DUMMY ARGUMENT IDON02 CORRESPONDS TO AN EXPRESSION00190083
701: C CONTAINING VARIABLES,ARITHMETIC OPERATORS AND CONSTANTS IN THE 00200083
702: C ACTUAL ARGUMENT OF THE MAIN PROGRAM. 00210083
703: C 00220083
704: C REFERENCES 00230083
705: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00240083
706: C X3.9-1978 00250083
707: C 00260083
708: C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS 00270083
709: C SECTION 15.5.1, FUNCTION SUBPROGRAM 00280083
710: C 00290083
711: C TEST SECTION 00300083
712: C 00310083
713: C FUNCTION SUBPROGRAM 00320083
714: C 00330083
715: IVON01 = IDON01 00340083
716: IVON02 = IDDN2A (1,1) 00350083
717: IVON03 = IDDN3A (2,3,4) 00360083
718: RVON04 = RDON02 00370083
719: C 00380083
720: RVON05 = IVON01 + IVON02 + IVON03 00390083
721: FF083 = RVON05 + RVON04 00400083
722: C 00410083
723: IDON01 = IVON01 + 10 00420083
724: IDDN2A (1,1) = IVON02 + 20 00430083
725: IDDN3A (2,3,4) = IVON03 + 40 00440083
726: C 00450083
727: RETURN 00460083
728: END 00470083
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.