![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM056.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 FM056.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 00010056
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 COMMENT SECTION 00020056
6: C 00030056
7: C FM056 00040056
8: C 00050056
9: C FM056 IS A MAIN WHICH TESTS THE ARGUMENT PASSING LINKAGE OF 00060056
10: C A 2 LEVEL NESTED SUBROUTINE AND AN EXTERNAL FUNCTION REFERENCE. 00070056
11: C THE MAIN PROGRAM FM056 CALLS SUBROUTINE FS057 PASSING ONE 00080056
12: C ARGUMENT. SUBROUTINE FS057 CALLS SUBROUTINE FS058 PASSING TWO 00090056
13: C ARGUMENTS. SUBROUTINE FS058 REFERENCES EXTERNAL FUNCTION FF059 00100056
14: C PASSING 3 ARGUMENTS. FUNCTION FF059 ADDS THE VALUES OF THE 3 00110056
15: C ARGUMENTS TOGETHER. SUBROUTINE FS057 AND FS058 THEN MERELY 00120056
16: C RETURN THE RESULT TO FM056 IN THE FIRST ARGUMENT. 00130056
17: C 00140056
18: C THE VALUES OF THE ARGUMENTS THAT ARE PASSED TO EACH 00150056
19: C SUBPROGRAM AND FUNCTION, AND RETURNED TO THE CALLING OR 00160056
20: C REFERENCING PROGRAM ARE SAVED IN AN INTEGER ARRAY. FM056 THEN 00170056
21: C USES THESE VALUES TO TEST THE COMPILER'S ARGUMENT PASSING 00180056
22: C CAPABILITIES. 00190056
23: C 00200056
24: C REFERENCES 00210056
25: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00220056
26: C X3.9-1978 00230056
27: C 00240056
28: C SECTION 15.6.2, SUBROUTINE REFERENCE 00250056
29: COMMON IACN11 (12) 00260056
30: C 00270056
31: C ********************************************************** 00280056
32: C 00290056
33: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00300056
34: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00310056
35: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00320056
36: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00330056
37: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00340056
38: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00350056
39: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00360056
40: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00370056
41: C OF EXECUTING THESE TESTS. 00380056
42: C 00390056
43: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00400056
44: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00410056
45: C 00420056
46: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00430056
47: C 00440056
48: C DEPARTMENT OF THE NAVY 00450056
49: C FEDERAL COBOL COMPILER TESTING SERVICE 00460056
50: C WASHINGTON, D.C. 20376 00470056
51: C 00480056
52: C ********************************************************** 00490056
53: C 00500056
54: C 00510056
55: C 00520056
56: C INITIALIZATION SECTION 00530056
57: C 00540056
58: C INITIALIZE CONSTANTS 00550056
59: C ************** 00560056
60: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00570056
61: I01 = 5 00580056
62: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00590056
63: I02 = 6 00600056
64: C SYSTEM ENVIRONMENT SECTION 00610056
65: C 00620056
66: I01 = 5 00630056
67: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00640056
68: C (UNIT NUMBER FOR CARD READER). 00650056
69: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00660056
70: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670056
71: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00680056
72: C 00690056
73: I02 = 6 00700056
74: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00710056
75: C (UNIT NUMBER FOR PRINTER). 00720056
76: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00730056
77: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00740056
78: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00750056
79: C 00760056
80: IVPASS=0 00770056
81: IVFAIL=0 00780056
82: IVDELE=0 00790056
83: ICZERO=0 00800056
84: C 00810056
85: C WRITE PAGE HEADERS 00820056
86: WRITE (I02,90000) 00830056
87: WRITE (I02,90001) 00840056
88: WRITE (I02,90002) 00850056
89: WRITE (I02, 90002) 00860056
90: WRITE (I02,90003) 00870056
91: WRITE (I02,90002) 00880056
92: WRITE (I02,90004) 00890056
93: WRITE (I02,90002) 00900056
94: WRITE (I02,90011) 00910056
95: WRITE (I02,90002) 00920056
96: WRITE (I02,90002) 00930056
97: WRITE (I02,90005) 00940056
98: WRITE (I02,90006) 00950056
99: WRITE (I02,90002) 00960056
100: C 00970056
101: C TEST SECTION 00980056
102: C 00990056
103: C SUBROUTINE SUBPROGRAM 01000056
104: C 01010056
105: IVON01 = 5 01020056
106: CALL FS057 (IVON01) 01030056
107: IACN11 (12) = IVON01 01040056
108: IVTNUM = 430 01050056
109: C 01060056
110: C **** TEST 430 **** 01070056
111: C 01080056
112: C TEST 430 TESTS THE VALUE OF THE ARGUMENT RECEIVED BY FS057 FROM 01090056
113: C A FM056 CALL TO FS057 01100056
114: C 01110056
115: IF (ICZERO) 34300, 4300, 34300 01120056
116: 4300 CONTINUE 01130056
117: IVCOMP = IACN11 (1) 01140056
118: GO TO 44300 01150056
119: 34300 IVDELE = IVDELE + 1 01160056
120: WRITE (I02,80003) IVTNUM 01170056
121: IF (ICZERO) 44300, 4311, 44300 01180056
122: 44300 IF (IVCOMP - 5) 24300,14300,24300 01190056
123: 14300 IVPASS = IVPASS + 1 01200056
124: WRITE (I02,80001) IVTNUM 01210056
125: GO TO 4311 01220056
126: 24300 IVFAIL = IVFAIL + 1 01230056
127: IVCORR = 5 01240056
128: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01250056
129: 4311 CONTINUE 01260056
130: IVTNUM = 431 01270056
131: C 01280056
132: C **** TEST 431 **** 01290056
133: C 01300056
134: C TEST 431 TESTS THE VALUE OF THE SECOND ARGUMENT THAT WAS PASSED 01310056
135: C FROM A FS057 CALL TO FS058 01320056
136: C 01330056
137: C 01340056
138: IF (ICZERO) 34310, 4310, 34310 01350056
139: 4310 CONTINUE 01360056
140: IVCOMP = IACN11 (2) 01370056
141: GO TO 44310 01380056
142: 34310 IVDELE = IVDELE + 1 01390056
143: WRITE (I02,80003) IVTNUM 01400056
144: IF (ICZERO) 44310, 4321, 44310 01410056
145: 44310 IF (IVCOMP - 4) 24310,14310,24310 01420056
146: 14310 IVPASS = IVPASS + 1 01430056
147: WRITE (I02,80001) IVTNUM 01440056
148: GO TO 4321 01450056
149: 24310 IVFAIL = IVFAIL + 1 01460056
150: IVCORR = 4 01470056
151: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01480056
152: 4321 CONTINUE 01490056
153: IVTNUM = 432 01500056
154: C 01510056
155: C **** TEST 432 **** 01520056
156: C 01530056
157: C TEST 432 TESTS THE VALUE OF THE FIRST ARGUMENT RECEIVED BY FS058 01540056
158: C FROM A FS057 CALL TO FS058 01550056
159: C 01560056
160: C 01570056
161: IF (ICZERO) 34320, 4320, 34320 01580056
162: 4320 CONTINUE 01590056
163: IVCOMP = IACN11 (3) 01600056
164: GO TO 44320 01610056
165: 34320 IVDELE = IVDELE + 1 01620056
166: WRITE (I02,80003) IVTNUM 01630056
167: IF (ICZERO) 44320, 4331, 44320 01640056
168: 44320 IF (IVCOMP - 5) 24320,14320,24320 01650056
169: 14320 IVPASS = IVPASS + 1 01660056
170: WRITE (I02,80001) IVTNUM 01670056
171: GO TO 4331 01680056
172: 24320 IVFAIL = IVFAIL + 1 01690056
173: IVCORR = 5 01700056
174: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01710056
175: 4331 CONTINUE 01720056
176: IVTNUM = 433 01730056
177: C 01740056
178: C **** TEST 433 **** 01750056
179: C 01760056
180: C TEST 433 TESTS THE VALUE OF THE SECOND ARGUMENT RECEIVED BY FS058 01770056
181: C FROM A FS057 CALL TO FS058 01780056
182: C 01790056
183: C 01800056
184: IF (ICZERO) 34330, 4330, 34330 01810056
185: 4330 CONTINUE 01820056
186: IVCOMP = IACN11 (4) 01830056
187: GO TO 44330 01840056
188: 34330 IVDELE = IVDELE + 1 01850056
189: WRITE (I02,80003) IVTNUM 01860056
190: IF (ICZERO) 44330, 4341, 44330 01870056
191: 44330 IF (IVCOMP - 4) 24330,14330,24330 01880056
192: 14330 IVPASS = IVPASS + 1 01890056
193: WRITE (I02,80001) IVTNUM 01900056
194: GO TO 4341 01910056
195: 24330 IVFAIL = IVFAIL + 1 01920056
196: IVCORR = 4 01930056
197: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01940056
198: 4341 CONTINUE 01950056
199: IVTNUM = 434 01960056
200: C 01970056
201: C **** TEST 434 **** 01980056
202: C 01990056
203: C TEST 434 TESTS THE VALUE OF THE THIRD ARGUMENT THAT WAS PASSED 02000056
204: C FROM A FS058 REFERENCE OF FUNCTION FF059 02010056
205: C 02020056
206: C 02030056
207: IF (ICZERO) 34340, 4340, 34340 02040056
208: 4340 CONTINUE 02050056
209: IVCOMP = IACN11 (5) 02060056
210: GO TO 44340 02070056
211: 34340 IVDELE = IVDELE + 1 02080056
212: WRITE (I02,80003) IVTNUM 02090056
213: IF (ICZERO) 44340, 4351, 44340 02100056
214: 44340 IF (IVCOMP - 3) 24340,14340,24340 02110056
215: 14340 IVPASS = IVPASS + 1 02120056
216: WRITE (I02,80001) IVTNUM 02130056
217: GO TO 4351 02140056
218: 24340 IVFAIL = IVFAIL + 1 02150056
219: IVCORR = 3 02160056
220: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02170056
221: 4351 CONTINUE 02180056
222: IVTNUM = 435 02190056
223: C 02200056
224: C **** TEST 435 **** 02210056
225: C 02220056
226: C TEST 435 TESTS THE VALUE OF THE FIRST ARGUMENT RECEIVED BY FF059 02230056
227: C FROM A FS058 REFERENCE OF FUNCTION FF059 02240056
228: C 02250056
229: C 02260056
230: IF (ICZERO) 34350, 4350, 34350 02270056
231: 4350 CONTINUE 02280056
232: IVCOMP = IACN11 (6) 02290056
233: GO TO 44350 02300056
234: 34350 IVDELE = IVDELE + 1 02310056
235: WRITE (I02,80003) IVTNUM 02320056
236: IF (ICZERO) 44350, 4361, 44350 02330056
237: 44350 IF (IVCOMP - 5) 24350,14350,24350 02340056
238: 14350 IVPASS = IVPASS + 1 02350056
239: WRITE (I02,80001) IVTNUM 02360056
240: GO TO 4361 02370056
241: 24350 IVFAIL = IVFAIL + 1 02380056
242: IVCORR = 5 02390056
243: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02400056
244: 4361 CONTINUE 02410056
245: IVTNUM = 436 02420056
246: C 02430056
247: C **** TEST 436 **** 02440056
248: C 02450056
249: C TEST 436 TESTS THE VALUE OF THE SECOND ARGUMENT RECEIVED BY FF059 02460056
250: C FROM A FS058 REFERENCE OF FUNCTION FF059 02470056
251: C 02480056
252: C 02490056
253: IF (ICZERO) 34360, 4360, 34360 02500056
254: 4360 CONTINUE 02510056
255: IVCOMP = IACN11 (7) 02520056
256: GO TO 44360 02530056
257: 34360 IVDELE = IVDELE + 1 02540056
258: WRITE (I02,80003) IVTNUM 02550056
259: IF (ICZERO) 44360, 4371, 44360 02560056
260: 44360 IF (IVCOMP - 4) 24360,14360,24360 02570056
261: 14360 IVPASS = IVPASS + 1 02580056
262: WRITE (I02,80001) IVTNUM 02590056
263: GO TO 4371 02600056
264: 24360 IVFAIL = IVFAIL + 1 02610056
265: IVCORR = 4 02620056
266: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02630056
267: 4371 CONTINUE 02640056
268: IVTNUM = 437 02650056
269: C 02660056
270: C **** TEST 437 **** 02670056
271: C 02680056
272: C TEST 437 TESTS THE VALUE OF THE THIRD ARGUMENT RECEIVED BY FF059 02690056
273: C FROM A FS058 REFERENCE OF FUNCTION FF059 02700056
274: C 02710056
275: C 02720056
276: IF (ICZERO) 34370, 4370, 34370 02730056
277: 4370 CONTINUE 02740056
278: IVCOMP = IACN11 (8) 02750056
279: GO TO 44370 02760056
280: 34370 IVDELE = IVDELE + 1 02770056
281: WRITE (I02,80003) IVTNUM 02780056
282: IF (ICZERO) 44370, 4381, 44370 02790056
283: 44370 IF (IVCOMP - 3) 24370,14370,24370 02800056
284: 14370 IVPASS = IVPASS + 1 02810056
285: WRITE (I02,80001) IVTNUM 02820056
286: GO TO 4381 02830056
287: 24370 IVFAIL = IVFAIL + 1 02840056
288: IVCORR = 3 02850056
289: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02860056
290: 4381 CONTINUE 02870056
291: IVTNUM = 438 02880056
292: C 02890056
293: C **** TEST 438 **** 02900056
294: C 02910056
295: C TEST 438 TESTS THE VALUE OF THE FUNCTION DETERMINED BY FF059 02920056
296: C 02930056
297: C 02940056
298: IF (ICZERO) 34380, 4380, 34380 02950056
299: 4380 CONTINUE 02960056
300: IVCOMP = IACN11 (9) 02970056
301: GO TO 44380 02980056
302: 34380 IVDELE = IVDELE + 1 02990056
303: WRITE (I02,80003) IVTNUM 03000056
304: IF (ICZERO) 44380, 4391, 44380 03010056
305: 44380 IF (IVCOMP - 12) 24380,14380,24380 03020056
306: 14380 IVPASS = IVPASS + 1 03030056
307: WRITE (I02,80001) IVTNUM 03040056
308: GO TO 4391 03050056
309: 24380 IVFAIL = IVFAIL + 1 03060056
310: IVCORR = 12 03070056
311: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03080056
312: 4391 CONTINUE 03090056
313: IVTNUM = 439 03100056
314: C 03110056
315: C **** TEST 439 **** 03120056
316: C 03130056
317: C TEST 439 TESTS THE VALUE OF THE FUNCTION RETURNED TO FS058 BY 03140056
318: C FF059 03150056
319: C 03160056
320: C 03170056
321: IF (ICZERO) 34390, 4390, 34390 03180056
322: 4390 CONTINUE 03190056
323: IVCOMP = IACN11 (10) 03200056
324: GO TO 44390 03210056
325: 34390 IVDELE = IVDELE + 1 03220056
326: WRITE (I02,80003) IVTNUM 03230056
327: IF (ICZERO) 44390, 4401, 44390 03240056
328: 44390 IF (IVCOMP - 12) 24390,14390,24390 03250056
329: 14390 IVPASS = IVPASS + 1 03260056
330: WRITE (I02,80001) IVTNUM 03270056
331: GO TO 4401 03280056
332: 24390 IVFAIL = IVFAIL + 1 03290056
333: IVCORR = 12 03300056
334: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03310056
335: 4401 CONTINUE 03320056
336: IVTNUM = 440 03330056
337: C 03340056
338: C **** TEST 440 **** 03350056
339: C 03360056
340: C TEST 440 TESTS THE VALUE OF THE FIRST ARGUMENT RETURNED TO FS057 03370056
341: C BY FS058 03380056
342: C 03390056
343: IF (ICZERO) 34400, 4400, 34400 03400056
344: 4400 CONTINUE 03410056
345: IVCOMP = IACN11 (11) 03420056
346: GO TO 44400 03430056
347: 34400 IVDELE = IVDELE + 1 03440056
348: WRITE (I02,80003) IVTNUM 03450056
349: IF (ICZERO) 44400, 4411, 44400 03460056
350: 44400 IF (IVCOMP - 12) 24400,14400,24400 03470056
351: 14400 IVPASS = IVPASS + 1 03480056
352: WRITE (I02,80001) IVTNUM 03490056
353: GO TO 4411 03500056
354: 24400 IVFAIL = IVFAIL + 1 03510056
355: IVCORR = 12 03520056
356: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03530056
357: 4411 CONTINUE 03540056
358: IVTNUM = 441 03550056
359: C 03560056
360: C **** TEST 441 **** 03570056
361: C 03580056
362: C TEST 441 TESTS THE VALUE OF THE FIRST ARGUMENT RETURNED TO FM056 03590056
363: C BY FS057 03600056
364: C 03610056
365: C 03620056
366: IF (ICZERO) 34410, 4410, 34410 03630056
367: 4410 CONTINUE 03640056
368: IVCOMP = IACN11 (12) 03650056
369: GO TO 44410 03660056
370: 34410 IVDELE = IVDELE + 1 03670056
371: WRITE (I02,80003) IVTNUM 03680056
372: IF (ICZERO) 44410, 4421, 44410 03690056
373: 44410 IF (IVCOMP - 12) 24410,14410,24410 03700056
374: 14410 IVPASS = IVPASS + 1 03710056
375: WRITE (I02,80001) IVTNUM 03720056
376: GO TO 4421 03730056
377: 24410 IVFAIL = IVFAIL + 1 03740056
378: IVCORR = 12 03750056
379: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03760056
380: 4421 CONTINUE 03770056
381: C 03780056
382: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03790056
383: 99999 CONTINUE 03800056
384: WRITE (I02,90002) 03810056
385: WRITE (I02,90006) 03820056
386: WRITE (I02,90002) 03830056
387: WRITE (I02,90002) 03840056
388: WRITE (I02,90007) 03850056
389: WRITE (I02,90002) 03860056
390: WRITE (I02,90008) IVFAIL 03870056
391: WRITE (I02,90009) IVPASS 03880056
392: WRITE (I02,90010) IVDELE 03890056
393: C 03900056
394: C 03910056
395: C TERMINATE ROUTINE EXECUTION 03920056
396: STOP 03930056
397: C 03940056
398: C FORMAT STATEMENTS FOR PAGE HEADERS 03950056
399: 90000 FORMAT (1H1) 03960056
400: 90002 FORMAT (1H ) 03970056
401: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03980056
402: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 03990056
403: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 04000056
404: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 04010056
405: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 04020056
406: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 04030056
407: C 04040056
408: C FORMAT STATEMENTS FOR RUN SUMMARIES 04050056
409: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 04060056
410: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 04070056
411: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 04080056
412: C 04090056
413: C FORMAT STATEMENTS FOR TEST RESULTS 04100056
414: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 04110056
415: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 04120056
416: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 04130056
417: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 04140056
418: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 04150056
419: C 04160056
420: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM056) 04170056
421: END 04180056
422: C 00010057
423: C DATE***82/08/02*18.33.46
424: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
425: C AUDIT FCVS78 V2.0
426: C COMMENT SECTION 00020057
427: C 00030057
428: C FS057 00040057
429: C 00050057
430: C THIS SUBROUTINE IS CALLED BY THE MAIN PROGRAM FM056. THE 00060057
431: C SINGLE ARGUMENT PASSED FROM FM056 ALONG WITH A SECOND PARAMETER 00070057
432: C CREATED IN FS057 ARE THEN PASSED VIA A CALL TO SUBROUTINE FS058. 00080057
433: C A RESULT FROM AN ARITHMETIC OPERATION IS RETURNED FROM FS058 IN 00090057
434: C THE FIRST ARGUMENT. FS057 ACCEPTS THIS RESULT AND RETURNS CONTROL00100057
435: C TO FM056 WITHOUT ANY ADDITIONAL PROCESSING. 00110057
436: C 00120057
437: C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FM056 TO 00130057
438: C FS057 AND RETURNED ARE SAVED IN AN INTEGER ARRAY FOR LATER 00140057
439: C VERIFICATION BY THE MAIN PROGRAM. 00150057
440: C 00160057
441: C REFERENCES 00170057
442: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00180057
443: C X3.9-1978 00190057
444: C 00200057
445: C SECTION 15.6, SUBROUTINES 00210057
446: C SECTION 15.6.2, SUBROUTINE REFERENCE 00220057
447: C SECTION 15.8, RETURN STATEMENT 00230057
448: C 00240057
449: C TEST SECTION 00250057
450: C 00260057
451: C SUBROUTINE SUBPROGRAM 00270057
452: C 00280057
453: SUBROUTINE FS057 (IVON01) 00290057
454: COMMON IACN11 (12) 00300057
455: IACN11 (1) = IVON01 00310057
456: IVON02 = 4 00320057
457: IACN11 (2) = IVON02 00330057
458: CALL FS058 (IVON01,IVON02) 00340057
459: IACN11 (11) = IVON01 00350057
460: RETURN 00360057
461: END 00370057
462: C 00010058
463: C DATE***82/08/02*18.33.46
464: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
465: C AUDIT FCVS78 V2.0
466: C COMMENT SECTION 00020058
467: C 00030058
468: C FS058 00040058
469: C 00050058
470: C THIS SUBROUTINE IS CALLED BY SUBROUTINE FS057. THE TWO 00060058
471: C ARGUMENTS PASSED FROM FS057 ALONG WITH A THIRD PARAMETER CREATED 00070058
472: C IN FS058 ARE THEN PASSED TO FUNCTION FF059 WHERE THEY ARE USED IN 00080058
473: C AN ARITHMETIC OPERATION. FS058 THEN SAVES THE RESULT OF THIS 00090058
474: C OPERATION IN THE FIRST ARGUMENT AND RETURNS CONTROL TO FS057 00100058
475: C WITHOUT ANY ADDITIONAL PROCESSING. 00110058
476: C 00120058
477: C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FS057 TO 00130058
478: C FS058 AND RETURNED ARE SAVED IN AN INTEGER ARRAY FOR LATER 00140058
479: C VERIFICATION BY THE MAIN PROGRAM. 00150058
480: C 00160058
481: C REFERENCES 00170058
482: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00180058
483: C X3.9-1978 00190058
484: C 00200058
485: C SECTION 15.5.2, REFERENCING EXTERNAL FUNCTIONS 00210058
486: C SECTION 15.6, SUBROUTINES 00220058
487: C SECTION 15.8, RETURN STATEMENT 00230058
488: C 00240058
489: C TEST SECTION 00250058
490: C 00260058
491: C SUBROUTINE SUBPROGRAM 00270058
492: C 00280058
493: SUBROUTINE FS058 (IVON01,IVON02) 00290058
494: COMMON IACN11 (12) 00300058
495: INTEGER FF059 00310058
496: IVON03 = 3 00320058
497: IACN11 (3) = IVON01 00330058
498: IACN11 (4) = IVON02 00340058
499: IACN11 (5) = IVON03 00350058
500: IVON01 = FF059 (IVON01,IVON02,IVON03) 00360058
501: IACN11 (10) = IVON01 00370058
502: RETURN 00380058
503: END 00390058
504: C 00010059
505: C DATE***82/08/02*18.33.46
506: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
507: C AUDIT FCVS78 V2.0
508: C COMMENT SECTION 00020059
509: C 00030059
510: C FF059 00040059
511: C 00050059
512: C THIS EXTERNAL FUNCTION IS REFERENCED WITHIN SUBROUTINE FS058.00060059
513: C THE THREE ARGUMENTS THAT ARE PASSED ARE SIMPLY ADDED TOGETHER AND 00070059
514: C THE RESULT SUBSTITUTED FOR THE ORIGINAL REFERENCE. CONTROL IS 00080059
515: C THEN RETURNED TO FS058. 00090059
516: C 00100059
517: C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FS058 TO 00110059
518: C FF059 AND THE RESULT THAT IS RETURNED ARE SAVED IN AN INTEGER 00120059
519: C ARRAY FOR LATER VERIFICATION BY THE MAIN PROGRAM. 00130059
520: C 00140059
521: C REFERENCES 00150059
522: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160059
523: C X3.9-1978 00170059
524: C 00180059
525: C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00190059
526: C SECTION 15.8, RETURN STATEMENT 00200059
527: C TEST SECTION 00210059
528: C 00220059
529: C FUNCTION SUBPROGRAM 00230059
530: C 00240059
531: INTEGER FUNCTION FF059 (IVON01,IVON02,IVON03) 00250059
532: COMMON IACN11 (12) 00260059
533: IACN11 (6) = IVON01 00270059
534: IACN11 (7) = IVON02 00280059
535: IACN11 (8) = IVON03 00290059
536: FF059 = IVON01 + IVON02 + IVON03 00300059
537: IACN11 (9) = IVON01 + IVON02 + IVON03 00310059
538: RETURN 00320059
539: END 00330059
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.