![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM050.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 FM050.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 00010050
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 00020050
6: C 00030050
7: C FM050 00040050
8: C 00050050
9: C THIS ROUTINE CONTAINS BASIC SUBROUTINE AND FUNCTION REFERENCE00060050
10: C TESTS. FOUR SUBROUTINES AND ONE FUNCTION ARE CALLED OR 00070050
11: C REFERENCED. FS051 IS CALLED TO TEST THE CALLING AND PASSING OF 00080050
12: C ARGUMENTS THROUGH UNLABELED COMMON. NO ARGUMENTS ARE SPECIFIED 00090050
13: C IN THE CALL LINE. FS052 IS IDENTICAL TO FS051 EXCEPT THAT SEVERAL00100050
14: C RETURNS ARE USED. FS053 UTILIZES MANY ARGUMENTS ON THE CALL 00110050
15: C STATEMENT AND MANY RETURN STATEMENTS IN THE SUBROUTINE BODY. 00120050
16: C FF054 IS A FUNCTION SUBROUTINE IN WHICH MANY ARGUMENTS AND RETURN 00130050
17: C STATEMENTS ARE USED. AND FINALLY FS055 PASSES A ONE DIMENIONAL 00140050
18: C ARRAY BACK TO FM050. 00150050
19: C 00160050
20: C REFERENCES 00170050
21: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00180050
22: C X3.9-1978 00190050
23: C 00200050
24: C SECTION 15.5.2, REFERENCING AN EXTERNAL FUNCTION 00210050
25: C SECTION 15.6.2, SUBROUTINE REFERENCE 00220050
26: C 00230050
27: COMMON RVCN01,IVCN01,IVCN02,IACN11(20) 00240050
28: INTEGER FF054 00250050
29: C 00260050
30: C ********************************************************** 00270050
31: C 00280050
32: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00290050
33: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00300050
34: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00310050
35: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00320050
36: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00330050
37: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00340050
38: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00350050
39: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00360050
40: C OF EXECUTING THESE TESTS. 00370050
41: C 00380050
42: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00390050
43: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00400050
44: C 00410050
45: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00420050
46: C 00430050
47: C DEPARTMENT OF THE NAVY 00440050
48: C FEDERAL COBOL COMPILER TESTING SERVICE 00450050
49: C WASHINGTON, D.C. 20376 00460050
50: C 00470050
51: C ********************************************************** 00480050
52: C 00490050
53: C 00500050
54: C 00510050
55: C INITIALIZATION SECTION 00520050
56: C 00530050
57: C INITIALIZE CONSTANTS 00540050
58: C ************** 00550050
59: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00560050
60: I01 = 5 00570050
61: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00580050
62: I02 = 6 00590050
63: C SYSTEM ENVIRONMENT SECTION 00600050
64: C 00610050
65: I01 = 5 00620050
66: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00630050
67: C (UNIT NUMBER FOR CARD READER). 00640050
68: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00650050
69: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00660050
70: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00670050
71: C 00680050
72: I02 = 6 00690050
73: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00700050
74: C (UNIT NUMBER FOR PRINTER). 00710050
75: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00720050
76: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00730050
77: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00740050
78: C 00750050
79: IVPASS=0 00760050
80: IVFAIL=0 00770050
81: IVDELE=0 00780050
82: ICZERO=0 00790050
83: C 00800050
84: C WRITE PAGE HEADERS 00810050
85: WRITE (I02,90000) 00820050
86: WRITE (I02,90001) 00830050
87: WRITE (I02,90002) 00840050
88: WRITE (I02, 90002) 00850050
89: WRITE (I02,90003) 00860050
90: WRITE (I02,90002) 00870050
91: WRITE (I02,90004) 00880050
92: WRITE (I02,90002) 00890050
93: WRITE (I02,90011) 00900050
94: WRITE (I02,90002) 00910050
95: WRITE (I02,90002) 00920050
96: WRITE (I02,90005) 00930050
97: WRITE (I02,90006) 00940050
98: WRITE (I02,90002) 00950050
99: C TEST SECTION 00960050
100: C 00970050
101: C SUBROUTINE AND FUNCTION SUBPROGRAMS 00980050
102: C 00990050
103: 4001 CONTINUE 01000050
104: IVTNUM = 400 01010050
105: C 01020050
106: C **** TEST 400 **** 01030050
107: C TEST 400 TESTS THE CALL TO A SUBROUTINE CONTAINING NO ARGUMENTS. 01040050
108: C ALL PARAMETERS ARE PASSED THROUGH UNLABELED COMMON. 01050050
109: C 01060050
110: IF (ICZERO) 34000, 4000, 34000 01070050
111: 4000 CONTINUE 01080050
112: RVCN01 = 2.1654 01090050
113: CALL FS051 01100050
114: RVCOMP = RVCN01 01110050
115: GO TO 44000 01120050
116: 34000 IVDELE = IVDELE + 1 01130050
117: WRITE (I02,80003) IVTNUM 01140050
118: IF (ICZERO) 44000, 4011, 44000 01150050
119: 44000 IF (RVCOMP - 3.1649) 24000,14000,44001 01160050
120: 44001 IF (RVCOMP - 3.1659) 14000,14000,24000 01170050
121: 14000 IVPASS = IVPASS + 1 01180050
122: WRITE (I02,80001) IVTNUM 01190050
123: GO TO 4011 01200050
124: 24000 IVFAIL = IVFAIL + 1 01210050
125: RVCORR = 3.1654 01220050
126: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01230050
127: 4011 CONTINUE 01240050
128: C 01250050
129: C TEST 401 THROUGH TEST 403 TEST THE CALL TO SUBROUTINE FS052 WHICH 01260050
130: C CONTAINS NO ARGUMENTS. ALL PARAMETERS ARE PASSED THROUGH 01270050
131: C UNLABELED COMMON. SUBROUTINE FS052 CONTAIN SEVERAL RETURN 01280050
132: C STATEMENTS. 01290050
133: C 01300050
134: IVTNUM = 401 01310050
135: C 01320050
136: C **** TEST 401 **** 01330050
137: C 01340050
138: IF (ICZERO) 34010, 4010, 34010 01350050
139: 4010 CONTINUE 01360050
140: IVCN01 = 5 01370050
141: IVCN02 = 1 01380050
142: CALL FS052 01390050
143: IVCOMP = IVCN01 01400050
144: GO TO 44010 01410050
145: 34010 IVDELE = IVDELE + 1 01420050
146: WRITE (I02,80003) IVTNUM 01430050
147: IF (ICZERO) 44010, 4021, 44010 01440050
148: 44010 IF (IVCOMP - 6) 24010,14010,24010 01450050
149: 14010 IVPASS = IVPASS + 1 01460050
150: WRITE (I02,80001) IVTNUM 01470050
151: GO TO 4021 01480050
152: 24010 IVFAIL = IVFAIL + 1 01490050
153: IVCORR = 6 01500050
154: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01510050
155: 4021 CONTINUE 01520050
156: IVTNUM = 402 01530050
157: C 01540050
158: C **** TEST 402 **** 01550050
159: C 01560050
160: IF (ICZERO) 34020, 4020, 34020 01570050
161: 4020 CONTINUE 01580050
162: IVCN01 = 10 01590050
163: IVCN02 = 5 01600050
164: CALL FS052 01610050
165: IVCOMP = IVCN01 01620050
166: GO TO 44020 01630050
167: 34020 IVDELE = IVDELE + 1 01640050
168: WRITE (I02,80003) IVTNUM 01650050
169: IF (ICZERO) 44020, 4031, 44020 01660050
170: 44020 IF (IVCOMP - 15) 24020,14020,24020 01670050
171: 14020 IVPASS = IVPASS + 1 01680050
172: WRITE (I02,80001) IVTNUM 01690050
173: GO TO 4031 01700050
174: 24020 IVFAIL = IVFAIL + 1 01710050
175: IVCORR = 15 01720050
176: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01730050
177: 4031 CONTINUE 01740050
178: IVTNUM = 403 01750050
179: C 01760050
180: C **** TEST 403 **** 01770050
181: C 01780050
182: IF (ICZERO) 34030, 4030, 34030 01790050
183: 4030 CONTINUE 01800050
184: IVCN01 = 30 01810050
185: IVCN02 = 3 01820050
186: CALL FS052 01830050
187: IVCOMP = IVCN01 01840050
188: GO TO 44030 01850050
189: 34030 IVDELE = IVDELE + 1 01860050
190: WRITE (I02,80003) IVTNUM 01870050
191: IF (ICZERO) 44030, 4041, 44030 01880050
192: 44030 IF (IVCOMP - 33) 24030,14030,24030 01890050
193: 14030 IVPASS = IVPASS + 1 01900050
194: WRITE (I02,80001) IVTNUM 01910050
195: GO TO 4041 01920050
196: 24030 IVFAIL = IVFAIL + 1 01930050
197: IVCORR = 33 01940050
198: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01950050
199: 4041 CONTINUE 01960050
200: C 01970050
201: C TEST 404 THROUGH TEST 406 TEST THE CALL TO SUBROUTINE FS053 WHICH 01980050
202: C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS. 01990050
203: C 02000050
204: IVTNUM = 404 02010050
205: C 02020050
206: C **** TEST 404 **** 02030050
207: C 02040050
208: IF (ICZERO) 34040, 4040, 34040 02050050
209: 4040 CONTINUE 02060050
210: CALL FS053 (6,10,11,IVON04,1) 02070050
211: IVCOMP = IVON04 02080050
212: GO TO 44040 02090050
213: 34040 IVDELE = IVDELE + 1 02100050
214: WRITE (I02,80003) IVTNUM 02110050
215: IF (ICZERO) 44040, 4051, 44040 02120050
216: 44040 IF (IVCOMP - 6) 24040,14040,24040 02130050
217: 14040 IVPASS = IVPASS + 1 02140050
218: WRITE (I02,80001) IVTNUM 02150050
219: GO TO 4051 02160050
220: 24040 IVFAIL = IVFAIL + 1 02170050
221: IVCORR = 6 02180050
222: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02190050
223: 4051 CONTINUE 02200050
224: IVTNUM = 405 02210050
225: C 02220050
226: C **** TEST 405 **** 02230050
227: C 02240050
228: IF (ICZERO) 34050, 4050, 34050 02250050
229: 4050 CONTINUE 02260050
230: IVCN01 = 10 02270050
231: CALL FS053 (6,IVCN01,11,IVON04,2) 02280050
232: IVCOMP = IVON04 02290050
233: GO TO 44050 02300050
234: 34050 IVDELE = IVDELE + 1 02310050
235: WRITE (I02,80003) IVTNUM 02320050
236: IF (ICZERO) 44050, 4061, 44050 02330050
237: 44050 IF (IVCOMP - 16) 24050,14050,24050 02340050
238: 14050 IVPASS = IVPASS + 1 02350050
239: WRITE (I02,80001) IVTNUM 02360050
240: GO TO 4061 02370050
241: 24050 IVFAIL = IVFAIL + 1 02380050
242: IVCORR = 16 02390050
243: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02400050
244: 4061 CONTINUE 02410050
245: IVTNUM = 406 02420050
246: C 02430050
247: C **** TEST 406 **** 02440050
248: C 02450050
249: IF (ICZERO) 34060, 4060, 34060 02460050
250: 4060 CONTINUE 02470050
251: IVON01 = 6 02480050
252: IVON02 = 10 02490050
253: IVON03 = 11 02500050
254: IVON05 = 3 02510050
255: CALL FS053 (IVON01,IVON02,IVON03,IVON04,IVON05) 02520050
256: IVCOMP = IVON04 02530050
257: GO TO 44060 02540050
258: 34060 IVDELE = IVDELE + 1 02550050
259: WRITE (I02,80003) IVTNUM 02560050
260: IF (ICZERO) 44060, 4071, 44060 02570050
261: 44060 IF (IVCOMP - 27) 24060,14060,24060 02580050
262: 14060 IVPASS = IVPASS + 1 02590050
263: WRITE (I02,80001) IVTNUM 02600050
264: GO TO 4071 02610050
265: 24060 IVFAIL = IVFAIL + 1 02620050
266: IVCORR = 27 02630050
267: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02640050
268: 4071 CONTINUE 02650050
269: C 02660050
270: C TEST 407 THROUGH 409 TEST THE REFERENCE TO FUNCTION FF054 WHICH 02670050
271: C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS 02680050
272: C 02690050
273: IVTNUM = 407 02700050
274: C 02710050
275: C **** TEST 407 **** 02720050
276: C 02730050
277: IF (ICZERO) 34070, 4070, 34070 02740050
278: 4070 CONTINUE 02750050
279: IVCOMP = FF054 (300,1,21,1) 02760050
280: GO TO 44070 02770050
281: 34070 IVDELE = IVDELE + 1 02780050
282: WRITE (I02,80003) IVTNUM 02790050
283: IF (ICZERO) 44070, 4081, 44070 02800050
284: 44070 IF (IVCOMP - 300) 24070,14070,24070 02810050
285: 14070 IVPASS = IVPASS + 1 02820050
286: WRITE (I02,80001) IVTNUM 02830050
287: GO TO 4081 02840050
288: 24070 IVFAIL = IVFAIL + 1 02850050
289: IVCORR = 300 02860050
290: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02870050
291: 4081 CONTINUE 02880050
292: IVTNUM = 408 02890050
293: C 02900050
294: C **** TEST 408 **** 02910050
295: C 02920050
296: IF (ICZERO) 34080, 4080, 34080 02930050
297: 4080 CONTINUE 02940050
298: IVON01 = 300 02950050
299: IVON04 = 2 02960050
300: IVCOMP = FF054 (IVON01,77,5,IVON04) 02970050
301: GO TO 44080 02980050
302: 34080 IVDELE = IVDELE + 1 02990050
303: WRITE (I02,80003) IVTNUM 03000050
304: IF (ICZERO) 44080, 4091, 44080 03010050
305: 44080 IF (IVCOMP - 377) 24080,14080,24080 03020050
306: 14080 IVPASS = IVPASS + 1 03030050
307: WRITE (I02,80001) IVTNUM 03040050
308: GO TO 4091 03050050
309: 24080 IVFAIL = IVFAIL + 1 03060050
310: IVCORR = 377 03070050
311: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03080050
312: 4091 CONTINUE 03090050
313: IVTNUM = 409 03100050
314: C 03110050
315: C **** TEST 409 **** 03120050
316: C 03130050
317: IF (ICZERO) 34090, 4090, 34090 03140050
318: 4090 CONTINUE 03150050
319: IVON01 = 71 03160050
320: IVON02 = 21 03170050
321: IVON03 = 17 03180050
322: IVON04 = 3 03190050
323: IVCOMP = FF054 (IVON01,IVON02,IVON03,IVON04) 03200050
324: GO TO 44090 03210050
325: 34090 IVDELE = IVDELE + 1 03220050
326: WRITE (I02,80003) IVTNUM 03230050
327: IF (ICZERO) 44090, 4101, 44090 03240050
328: 44090 IF (IVCOMP - 109) 24090,14090,24090 03250050
329: 14090 IVPASS = IVPASS + 1 03260050
330: WRITE (I02,80001) IVTNUM 03270050
331: GO TO 4101 03280050
332: 24090 IVFAIL = IVFAIL + 1 03290050
333: IVCORR = 109 03300050
334: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03310050
335: 4101 CONTINUE 03320050
336: C 03330050
337: C TEST 410 THROUGH 429 TEST THE CALL TO SUBROUTINE FS055 WHICH 03340050
338: C CONTAINS NO ARGUMENTS. THE PARAMETERS ARE PASSED THROUGH AN 03350050
339: C INTEGER ARRAY VARIABLE IN UNLABELED COMMON. 03360050
340: C 03370050
341: CALL FS055 03380050
342: DO 20 I = 1,20 03390050
343: IF (ICZERO) 34100, 4100, 34100 03400050
344: 4100 CONTINUE 03410050
345: IVTNUM = 409 + I 03420050
346: IVCOMP = IACN11(I) 03430050
347: GO TO 44100 03440050
348: 34100 IVDELE = IVDELE + 1 03450050
349: WRITE (I02,80003) IVTNUM 03460050
350: IF (ICZERO) 44100, 4111, 44100 03470050
351: 44100 IF (IVCOMP - I) 24100,14100,24100 03480050
352: 14100 IVPASS = IVPASS + 1 03490050
353: WRITE (I02,80001) IVTNUM 03500050
354: GO TO 4111 03510050
355: 24100 IVFAIL = IVFAIL + 1 03520050
356: IVCORR = I 03530050
357: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03540050
358: 4111 CONTINUE 03550050
359: 20 CONTINUE 03560050
360: C 03570050
361: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03580050
362: 99999 CONTINUE 03590050
363: WRITE (I02,90002) 03600050
364: WRITE (I02,90006) 03610050
365: WRITE (I02,90002) 03620050
366: WRITE (I02,90002) 03630050
367: WRITE (I02,90007) 03640050
368: WRITE (I02,90002) 03650050
369: WRITE (I02,90008) IVFAIL 03660050
370: WRITE (I02,90009) IVPASS 03670050
371: WRITE (I02,90010) IVDELE 03680050
372: C 03690050
373: C 03700050
374: C TERMINATE ROUTINE EXECUTION 03710050
375: STOP 03720050
376: C 03730050
377: C FORMAT STATEMENTS FOR PAGE HEADERS 03740050
378: 90000 FORMAT (1H1) 03750050
379: 90002 FORMAT (1H ) 03760050
380: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03770050
381: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 03780050
382: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 03790050
383: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 03800050
384: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 03810050
385: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 03820050
386: C 03830050
387: C FORMAT STATEMENTS FOR RUN SUMMARIES 03840050
388: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 03850050
389: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 03860050
390: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 03870050
391: C 03880050
392: C FORMAT STATEMENTS FOR TEST RESULTS 03890050
393: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 03900050
394: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 03910050
395: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 03920050
396: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 03930050
397: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 03940050
398: C 03950050
399: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM050) 03960050
400: END 03970050
401: C 00010051
402: C DATE***82/08/02*18.33.46
403: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
404: C AUDIT FCVS78 V2.0
405: C COMMENT SECTION 00020051
406: C 00030051
407: C FS051 00040051
408: C 00050051
409: C FS051 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060051
410: C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070051
411: C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS051 00080051
412: C INCREMENTS THE VALUE OF A REAL VARIABLE BY 1 AND RETURNS CONTROL 00090051
413: C TO THE CALLING PROGRAM FM050. 00100051
414: C 00110051
415: C REFERENCES 00120051
416: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130051
417: C X3.9-1978 00140051
418: C 00150051
419: C SECTION 15.6, SUBROUTINES 00160051
420: C SECTION 15.8, RETURN STATEMENT 00170051
421: C 00180051
422: C TEST SECTION 00190051
423: C 00200051
424: C SUBROUTINE SUBPROGRAM - NO ARGUMENTS 00210051
425: C 00220051
426: SUBROUTINE FS051 00230051
427: COMMON //RVCN01 00240051
428: RVCN01 = RVCN01 + 1.0 00250051
429: RETURN 00260051
430: END 00270051
431: C 00010052
432: C DATE***82/08/02*18.33.46
433: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
434: C AUDIT FCVS78 V2.0
435: C COMMENT SECTION 00020052
436: C 00030052
437: C FS052 00040052
438: C 00050052
439: C FS052 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060052
440: C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070052
441: C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS052 00080052
442: C INCREMENTS THE VALUE OF ONE INTEGER VARIABLE BY 1,2,3,4 OR 5 00090052
443: C DEPENDING ON THE VALUE OF A SECOND INTEGER VARIABLE AND THEN 00100052
444: C RETURNS CONTROL TO THE CALLING PROGRAM FM050. SEVERAL RETURN 00110052
445: C STATEMENTS ARE INCLUDED. 00120052
446: C 00130052
447: C REFERENCES 00140052
448: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150052
449: C X3.9-1978 00160052
450: C 00170052
451: C SECTION 15.6, SUBROUTINES 00180052
452: C SECTION 15.8, RETURN STATEMENT 00190052
453: C 00200052
454: C TEST SECTION 00210052
455: C 00220052
456: C SUBROUTINE SUBPROGRAM - NO ARGUMENTS, MANY RETURNS 00230052
457: C 00240052
458: SUBROUTINE FS052 00250052
459: COMMON RVDN01,IVCN01,IVCN02 00260052
460: GO TO (10,20,30,40,50),IVCN02 00270052
461: 10 IVCN01 = IVCN01 + 1 00280052
462: RETURN 00290052
463: 20 IVCN01 = IVCN01 + 2 00300052
464: RETURN 00310052
465: 30 IVCN01 = IVCN01 + 3 00320052
466: RETURN 00330052
467: 40 IVCN01 = IVCN01 + 4 00340052
468: RETURN 00350052
469: 50 IVCN01 = IVCN01 + 5 00360052
470: RETURN 00370052
471: END 00380052
472: C 00010053
473: C DATE***82/08/02*18.33.46
474: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
475: C AUDIT FCVS78 V2.0
476: C COMMENT SECTION 00020053
477: C 00030053
478: C FS053 00040053
479: C 00050053
480: C FS053 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060053
481: C PROGRAM FM050. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND 00070053
482: C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE SUBROUTINE FS053 00080053
483: C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS 00090053
484: C DEPENDING ON THE VALUE OF THE FIFTH ARGUMENT. THE RESULTING SUM 00100053
485: C IS THEN RETURNED TO THE CALLING PROGRAM FM050 THROUGH THE FOURTH 00110053
486: C ARGUMENT. 00120053
487: C 00130053
488: C REFERENCES 00140053
489: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150053
490: C X3.9-1978 00160053
491: C 00170053
492: C SECTION 15.6, SUBROUTINES 00180053
493: C SECTION 15.8, RETURN STATEMENT 00190053
494: C 00200053
495: C TEST SECTION 00210053
496: C 00220053
497: C SUBROUTINE SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS 00230053
498: C 00240053
499: SUBROUTINE FS053 (IVON01,IVON02,IVON03,IVON04,IVON05) 00250053
500: GO TO (10,20,30),IVON05 00260053
501: 10 IVON04 = IVON01 00270053
502: RETURN 00280053
503: 20 IVON04 = IVON01 + IVON02 00290053
504: RETURN 00300053
505: 30 IVON04 = IVON01 + IVON02 + IVON03 00310053
506: RETURN 00320053
507: END 00330053
508: C 00010054
509: C DATE***82/08/02*18.33.46
510: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
511: C AUDIT FCVS78 V2.0
512: C COMMENT SECTION 00020054
513: C 00030054
514: C FF054 00040054
515: C 00050054
516: C FF054 IS A FUNCTION SUBPROGRAM WHICH IS REFERENCED BY THE 00060054
517: C MAIN PROGRAM. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND 00070054
518: C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE FUNCTION FF054 00080054
519: C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS 00090054
520: C DEPENDING ON THE VALUE OF THE FOURTH ARGUMENT. THE RESULTING SUM 00100054
521: C IS THEN RETURNED TO THE REFERENCING PROGRAM FM050 THROUGH THE 00110054
522: C FUNCTION REFERENCE. 00120054
523: C 00130054
524: C REFERENCES 00140054
525: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150054
526: C X3.9-1978 00160054
527: C 00170054
528: C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00180054
529: C SECTION 15.8, RETURN STATEMENT 00190054
530: C 00200054
531: C TEST SECTION 00210054
532: C 00220054
533: C FUNCTION SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS 00230054
534: C 00240054
535: INTEGER FUNCTION FF054 (IVON01,IVON02,IVON03,IVON04) 00250054
536: GO TO (10,20,30),IVON04 00260054
537: 10 FF054 = IVON01 00270054
538: RETURN 00280054
539: 20 FF054 = IVON01 + IVON02 00290054
540: RETURN 00300054
541: 30 FF054 = IVON01 + IVON02 + IVON03 00310054
542: RETURN 00320054
543: END 00330054
544: C 00010055
545: C DATE***82/08/02*18.33.46
546: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
547: C AUDIT FCVS78 V2.0
548: C COMMENT SECTION 00020055
549: C 00030055
550: C FS055 00040055
551: C 00050055
552: C FS055 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060055
553: C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070055
554: C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS055 00080055
555: C INITIALIZES A ONE DIMENSIONAL INTEGER ARRAY OF 20 ELEMENTS WITH 00090055
556: C THE VALUES 1 THROUGH 20 RESPECTIVELY. CONTROL IS THEN RETURNED 00100055
557: C TO THE CALLING PROGRAM FM050. 00110055
558: C 00120055
559: C REFERENCES 00130055
560: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140055
561: C X3.9-1978 00150055
562: C 00160055
563: C SECTION 15.6, SUBROUTINES 00170055
564: C SECTION 15.8, RETURN STATEMENT 00180055
565: C 00190055
566: C TEST SECTION 00200055
567: C 00210055
568: C SUBROUTINE SUBPROGRAM - ARRAY ARGUMENTS 00220055
569: C 00230055
570: SUBROUTINE FS055 00240055
571: COMMON RVCN01,IVCN01,IVCN02,IACN11 00250055
572: DIMENSION IACN11(20) 00260055
573: DO 20 I = 1,20 00270055
574: IACN11(I) = I 00280055
575: 20 CONTINUE 00290055
576: RETURN 00300055
577: END 00310055
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.