![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM328.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 FM328.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 root 1: PROGRAM FM328 00010328
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 00020328
6: C 00030328
7: C THIS ROUTINE TEST SUBSET LEVEL FEATURES OF 00040328
8: C SUBROUTINE SUBPROGRAMS. TESTS ARE DESIGNED TO CHECK THE 00050328
9: C ASSOCIATION OF ALL PERMISSIBLE FORMS OF ACTUAL ARGUMENTS WITH 00060328
10: C VARIABLE, ARRAY AND PROCEDURE NAME DUMMY ARGUMENTS. THESE 00070328
11: C INCLUDE, 00080328
12: C 00090328
13: C 1) ACTUAL ARGUMENTS ASSOCIATED TO VARIABLE NAME DUMMY 00100328
14: C ARGUMENT INCLUDE, 00110328
15: C 00120328
16: C A) CONSTANT 00130328
17: C B) VARIABLE NAME 00140328
18: C C) ARRAY ELEMENT NAME 00150328
19: C D) EXPRESSION INVOLVING OPERATORS 00160328
20: C E) EXPRESSION ENCLOSED IN PARENTHESES 00170328
21: C F) INTRINSIC FUNCTION REFERENCE 00180328
22: C G) EXTERNAL FUNCTION REFERENCE 00190328
23: C H) STATEMENT FUNCTION REFERENCE 00200328
24: C I) ACTUAL ARGUMENT NAME SAME AS DUMMY ARGUMENT NAME 00210328
25: C 00220328
26: C 2) ACTUAL ARGUMENTS ASSOCIATED TO ARRAY NAME DUMMY 00230328
27: C ARGUMENT INCLUDE, 00240328
28: C 00250328
29: C A) ARRAY NAME 00260328
30: C B) ARRAY ELEMENT NAME 00270328
31: C 00280328
32: C 3) ACTUAL ARGUMENTS ASSOCIATED TO PROCEDURE NAME DUMMY 00290328
33: C ARGUMENT INCLUDE, 00300328
34: C 00310328
35: C A) EXTERNAL FUNCTION NAME 00320328
36: C B) INTRINSIC FUNCTION NAME 00330328
37: C C) SUBROUTINE NAME 00340328
38: C 00350328
39: C ALL DATA PASSED TO THE REFERENCED SUBPROGRAMS ARE PASSED VIA 00360328
40: C ARGUMENT VALUES, WHILE ALL RESULTS RETURNED TO FM328 ARE 00370328
41: C RETURNED VIA VARIABLES IN NAMED COMMON. SUBSET LEVEL ROUTINES 00380328
42: C FM026, FM050 AND FM056 ALSO TEST THE USE OF SUBROUTINES. 00390328
43: C 00400328
44: C REFERENCES. 00410328
45: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00420328
46: C X3.9-1978 00430328
47: C 00440328
48: C SECTION 2.8, DUMMY ARGUMENTS 00450328
49: C SECTION 5.1.2.2, DUMMY ARRAY DECLARATOR 00460328
50: C SECTION 5.5, DUMMY AND ACTUAL ARRAYS 00470328
51: C SECTION 8.1, DIMENSION STATEMENT 00480328
52: C SECTION 8.3, COMMON STATEMENT 00490328
53: C SECTION 8.4, TYPE-STATEMENT 00500328
54: C SECTION 8.7, EXTERNAL STATEMENT 00510328
55: C SECTION 8.8, INTRINSIC STATEMENT 00520328
56: C SECTION 15.2, REFERENCING A FUNCTION 00530328
57: C SECTION 15.3, INTRINSIC FUNCTIONS 00540328
58: C SECTION 15.5, EXTERNAL FUNCTIONS 00550328
59: C SECTION 15.6, SUBROUTINES 00560328
60: C SECTION 15.9, ARGUMENTS AND COMMON BLOCKS 00570328
61: C 00580328
62: C 00590328
63: C ******************************************************************00600328
64: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00610328
65: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00620328
66: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00630328
67: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00640328
68: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00650328
69: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00660328
70: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00670328
71: C THE RESULT OF EXECUTING THESE TESTS. 00680328
72: C 00690328
73: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00700328
74: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00710328
75: C 00720328
76: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00730328
77: C DEPARTMENT OF THE NAVY 00740328
78: C FEDERAL COBOL COMPILER TESTING SERVICE 00750328
79: C WASHINGTON, D.C. 20376 00760328
80: C 00770328
81: C ******************************************************************00780328
82: C 00790328
83: C 00800328
84: IMPLICIT LOGICAL (L) 00810328
85: IMPLICIT CHARACTER*14 (C) 00820328
86: C 00830328
87: INTEGER IATN11(2,3) 00840328
88: REAL RATN11(3,4) 00850328
89: INTEGER FF330 00860328
90: DIMENSION IADN11(4), IADN12(4) 00870328
91: DIMENSION RADN11(4), RADN12(4) 00880328
92: DIMENSION LADN11(4) 00890328
93: COMMON /BLK1/IVCN01, RVCN01, LVCN01 00900328
94: COMMON IACN11(6), RACN11(10) 00910328
95: EXTERNAL FF330, FS335 00920328
96: INTRINSIC ABS, IABS, NINT 00930328
97: IFOS01(IDON04) = IDON04 + 1 00940328
98: RFOS01(RDON04) = RDON04 + 1.0 00950328
99: LFOS01(LDON04) = .NOT. LDON04 00960328
100: C 00970328
101: C 00980328
102: C 00990328
103: C INITIALIZATION SECTION. 01000328
104: C 01010328
105: C INITIALIZE CONSTANTS 01020328
106: C ******************** 01030328
107: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01040328
108: I01 = 5 01050328
109: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01060328
110: I02 = 6 01070328
111: C SYSTEM ENVIRONMENT SECTION 01080328
112: C 01090328
113: I01 = 5 01100328
114: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01110328
115: C (UNIT NUMBER FOR CARD READER). 01120328
116: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01130328
117: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01140328
118: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01150328
119: C 01160328
120: I02 = 6 01170328
121: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01180328
122: C (UNIT NUMBER FOR PRINTER). 01190328
123: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01200328
124: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01210328
125: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01220328
126: C 01230328
127: IVPASS = 0 01240328
128: IVFAIL = 0 01250328
129: IVDELE = 0 01260328
130: ICZERO = 0 01270328
131: C 01280328
132: C WRITE OUT PAGE HEADERS 01290328
133: C 01300328
134: WRITE (I02,90002) 01310328
135: WRITE (I02,90006) 01320328
136: WRITE (I02,90008) 01330328
137: WRITE (I02,90004) 01340328
138: WRITE (I02,90010) 01350328
139: WRITE (I02,90004) 01360328
140: WRITE (I02,90016) 01370328
141: WRITE (I02,90001) 01380328
142: WRITE (I02,90004) 01390328
143: WRITE (I02,90012) 01400328
144: WRITE (I02,90014) 01410328
145: WRITE (I02,90004) 01420328
146: C 01430328
147: C 01440328
148: C TEST 001 THROUGH TEST 013 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 01450328
149: C OF ACTUAL ARGUMENTS TO VARIABLE NAMES USED AS SUBROUTINE 01460328
150: C DUMMY ARGUMENTS. INTEGER, REAL AND LOGICAL DUMMY ARGUMENTS ARE 01470328
151: C TESTED. 01480328
152: C 01490328
153: C 01500328
154: C **** FCVS PROGRAM 328 - TEST 001 **** 01510328
155: C 01520328
156: C USE INTEGER, REAL AND LOGICAL CONSTANTS AS ACTUAL ARGUMENTS. 01530328
157: C 01540328
158: IVTNUM = 1 01550328
159: IF (ICZERO) 30010, 0010, 30010 01560328
160: 0010 CONTINUE 01570328
161: CALL FS329(3, 3.0, .FALSE.) 01580328
162: IVCOMP = 1 01590328
163: IF (IVCN01 .EQ. 4) IVCOMP = IVCOMP * 2 01600328
164: IF (RVCN01 .GE. 3.9995 .AND. RVCN01 .LE. 4.0005) IVCOMP = IVCOMP*301610328
165: IF (LVCN01) IVCOMP = IVCOMP * 5 01620328
166: IVCORR = 30 01630328
167: 40010 IF (IVCOMP - 30) 20010, 10010, 20010 01640328
168: 30010 IVDELE = IVDELE + 1 01650328
169: WRITE (I02,80000) IVTNUM 01660328
170: IF (ICZERO) 10010, 0021, 20010 01670328
171: 10010 IVPASS = IVPASS + 1 01680328
172: WRITE (I02,80002) IVTNUM 01690328
173: GO TO 0021 01700328
174: 20010 IVFAIL = IVFAIL + 1 01710328
175: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01720328
176: 0021 CONTINUE 01730328
177: C 01740328
178: C **** FCVS PROGRAM 328 - TEST 002 **** 01750328
179: C 01760328
180: C USE INTEGER, REAL AND LOGICAL VARIABLES AS ACTUAL ARGUMENTS. 01770328
181: C 01780328
182: IVTNUM = 2 01790328
183: IF (ICZERO) 30020, 0020, 30020 01800328
184: 0020 CONTINUE 01810328
185: IVON01 = 7 01820328
186: RVON01 = 7.0 01830328
187: LVON01 = .TRUE. 01840328
188: CALL FS329(IVON01, RVON01, LVON01) 01850328
189: IVCOMP = 1 01860328
190: IF (IVCN01 .EQ. 8) IVCOMP =IVCOMP * 2 01870328
191: IF (RVCN01 .GE. 7.9995 .AND. RVCN01 .LE. 8.0005) IVCOMP = IVCOMP*301880328
192: IF (.NOT. LVCN01) IVCOMP = IVCOMP * 5 01890328
193: IVCORR = 30 01900328
194: 40020 IF (IVCOMP - 30) 20020, 10020, 20020 01910328
195: 30020 IVDELE = IVDELE + 1 01920328
196: WRITE (I02,80000) IVTNUM 01930328
197: IF (ICZERO) 10020, 0031, 20020 01940328
198: 10020 IVPASS = IVPASS + 1 01950328
199: WRITE (I02,80002) IVTNUM 01960328
200: GO TO 0031 01970328
201: 20020 IVFAIL = IVFAIL + 1 01980328
202: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01990328
203: 0031 CONTINUE 02000328
204: C 02010328
205: C **** FCVS PROGRAM 328 - TEST 003 **** 02020328
206: C 02030328
207: C USE INTEGER, REAL AND LOGICAL ARRAY ELEMENT NAMES AS ACTUAL 02040328
208: C ARGUMENTS. 02050328
209: C 02060328
210: IVTNUM = 3 02070328
211: IF (ICZERO) 30030, 0030, 30030 02080328
212: 0030 CONTINUE 02090328
213: IADN11(2) = 2 02100328
214: RADN11(4) = 4.0 02110328
215: LADN11(1) = .FALSE. 02120328
216: CALL FS329(IADN11(2), RADN11(4), LADN11(1)) 02130328
217: IVCOMP = 1 02140328
218: IF (IVCN01 .EQ. 3) IVCOMP = IVCOMP * 2 02150328
219: IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*302160328
220: IF (LVCN01) IVCOMP = IVCOMP * 5 02170328
221: IVCORR = 30 02180328
222: 40030 IF (IVCOMP - 30) 20030, 10030, 20030 02190328
223: 30030 IVDELE = IVDELE + 1 02200328
224: WRITE (I02,80000) IVTNUM 02210328
225: IF (ICZERO) 10030, 0041, 20030 02220328
226: 10030 IVPASS = IVPASS + 1 02230328
227: WRITE (I02,80002) IVTNUM 02240328
228: GO TO 0041 02250328
229: 20030 IVFAIL = IVFAIL + 1 02260328
230: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02270328
231: 0041 CONTINUE 02280328
232: C 02290328
233: C **** FCVS PROGRAM 328 - TEST 004 **** 02300328
234: C 02310328
235: C INTEGER AND REAL EXPRESSIONS INVOLVING OPERATORS AS ACTUAL 02320328
236: C ARGUMENTS. 02330328
237: C 02340328
238: IVTNUM = 4 02350328
239: IF (ICZERO) 30040, 0040, 30040 02360328
240: 0040 CONTINUE 02370328
241: IVON02 = 2 02380328
242: IVON03 = 3 02390328
243: RVON02 = 2. 02400328
244: RVON03 = 1.2 02410328
245: CALL FS329(IVON02 + 3 * IVON03 - 7, RVON02 *RVON03 / .6, .TRUE.) 02420328
246: IVCOMP = 1 02430328
247: IF (IVCN01 .EQ. 5) IVCOMP = IVCOMP * 2 02440328
248: IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*302450328
249: IVCORR = 6 02460328
250: 40040 IF (IVCOMP - 6) 20040, 10040, 20040 02470328
251: 30040 IVDELE = IVDELE + 1 02480328
252: WRITE (I02,80000) IVTNUM 02490328
253: IF (ICZERO) 10040, 0051, 20040 02500328
254: 10040 IVPASS = IVPASS + 1 02510328
255: WRITE (I02,80002) IVTNUM 02520328
256: GO TO 0051 02530328
257: 20040 IVFAIL = IVFAIL + 1 02540328
258: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02550328
259: 0051 CONTINUE 02560328
260: C 02570328
261: C **** FCVS PROGRAM 328 - TEST 005 **** 02580328
262: C 02590328
263: C REAL EXPRESSION INVOLVING INTEGER AND REAL PRIMARIES AND OPERATORS02600328
264: C AS ACTUAL ARGUMENT. 02610328
265: C 02620328
266: IVTNUM = 5 02630328
267: IF (ICZERO) 30050, 0050, 30050 02640328
268: 0050 CONTINUE 02650328
269: RVCOMP = 0.0 02660328
270: IVON01 = 2 02670328
271: RADN11(2) = 2.5 02680328
272: CALL FS329(1, IVON01**3 * (RADN11(2) - 1) + 2.0, .TRUE.) 02690328
273: RVCOMP = RVCN01 02700328
274: RVCORR = 15.0 02710328
275: 40050 IF (RVCOMP - 14.995) 20050, 10050, 40051 02720328
276: 40051 IF (RVCOMP - 15.005) 10050, 10050, 20050 02730328
277: 30050 IVDELE = IVDELE + 1 02740328
278: WRITE (I02,80000) IVTNUM 02750328
279: IF (ICZERO) 10050, 0061, 20050 02760328
280: 10050 IVPASS = IVPASS + 1 02770328
281: WRITE (I02,80002) IVTNUM 02780328
282: GO TO 0061 02790328
283: 20050 IVFAIL = IVFAIL + 1 02800328
284: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02810328
285: 0061 CONTINUE 02820328
286: C 02830328
287: C **** FCVS PROGRAM 328 - TEST 006 **** 02840328
288: C 02850328
289: C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.NOT.) AS ACTUAL 02860328
290: C ARGUMENT. 02870328
291: C 02880328
292: IVTNUM = 6 02890328
293: IF (ICZERO) 30060, 0060, 30060 02900328
294: 0060 CONTINUE 02910328
295: LVON01 = .TRUE. 02920328
296: CALL FS329(1, 1.0, .NOT. LVON01) 02930328
297: IVCOMP = 0 02940328
298: IF (LVCN01) IVCOMP = 1 02950328
299: IVCORR = 1 02960328
300: 40060 IF (IVCOMP - 1) 20060, 10060, 20060 02970328
301: 30060 IVDELE = IVDELE + 1 02980328
302: WRITE (I02,80000) IVTNUM 02990328
303: IF (ICZERO) 10060, 0071, 20060 03000328
304: 10060 IVPASS = IVPASS + 1 03010328
305: WRITE (I02,80002) IVTNUM 03020328
306: GO TO 0071 03030328
307: 20060 IVFAIL = IVFAIL + 1 03040328
308: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03050328
309: 0071 CONTINUE 03060328
310: C 03070328
311: C **** FCVS PROGRAM 328 - TEST 007 **** 03080328
312: C 03090328
313: C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.OR.) AS ACTIVE 03100328
314: C ARGUMENT. 03110328
315: C 03120328
316: IVTNUM = 7 03130328
317: IF (ICZERO) 30070, 0070, 30070 03140328
318: 0070 CONTINUE 03150328
319: LVON01 = .TRUE. 03160328
320: LVON02 = .FALSE. 03170328
321: CALL FS329(1, 1.0, LVON01 .OR. LVON02) 03180328
322: IVCOMP = 0 03190328
323: IF (.NOT. LVCN01) IVCOMP = 1 03200328
324: IVCORR = 1 03210328
325: 40070 IF (IVCOMP - 1) 20070, 10070, 20070 03220328
326: 30070 IVDELE = IVDELE + 1 03230328
327: WRITE (I02,80000) IVTNUM 03240328
328: IF (ICZERO) 10070, 0081, 20070 03250328
329: 10070 IVPASS = IVPASS + 1 03260328
330: WRITE (I02,80002) IVTNUM 03270328
331: GO TO 0081 03280328
332: 20070 IVFAIL = IVFAIL + 1 03290328
333: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03300328
334: 0081 CONTINUE 03310328
335: C 03320328
336: C **** FCVS PROGRAM 328 - TEST 008 **** 03330328
337: C 03340328
338: C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.AND.) AS ACTUAL 03350328
339: C ARGUMENT. 03360328
340: C 03370328
341: IVTNUM = 8 03380328
342: IF (ICZERO) 30080, 0080, 30080 03390328
343: 0080 CONTINUE 03400328
344: LVON01 = .FALSE. 03410328
345: LVON02 = .TRUE. 03420328
346: CALL FS329(1, 1.0, LVON01 .AND. LVON02) 03430328
347: IVCOMP = 0 03440328
348: IF (LVCN01) IVCOMP = 1 03450328
349: IVCORR = 1 03460328
350: 40080 IF (IVCOMP - 1) 20080, 10080, 20080 03470328
351: 30080 IVDELE = IVDELE + 1 03480328
352: WRITE (I02,80000) IVTNUM 03490328
353: IF (ICZERO) 10080, 0091, 20080 03500328
354: 10080 IVPASS = IVPASS + 1 03510328
355: WRITE (I02,80002) IVTNUM 03520328
356: GO TO 0091 03530328
357: 20080 IVFAIL = IVFAIL + 1 03540328
358: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03550328
359: 0091 CONTINUE 03560328
360: C 03570328
361: C **** FCVS PROGRAM 328 - TEST 009 **** 03580328
362: C 03590328
363: C EXPRESSION ENCLOSED IN PARENTHESES AS ACTUAL ARGUMENT. 03600328
364: C 03610328
365: IVTNUM = 9 03620328
366: IF (ICZERO) 30090, 0090, 30090 03630328
367: 0090 CONTINUE 03640328
368: IVCOMP = 0 03650328
369: IVON01 = 6 03660328
370: CALL FS329((IVON01 + 3), 1.0, .TRUE.) 03670328
371: IVCOMP = IVCN01 03680328
372: IVCORR = 10 03690328
373: 40090 IF (IVCOMP - 10) 20090, 10090, 20090 03700328
374: 30090 IVDELE = IVDELE + 1 03710328
375: WRITE (I02,80000) IVTNUM 03720328
376: IF (ICZERO) 10090, 0101, 20090 03730328
377: 10090 IVPASS = IVPASS + 1 03740328
378: WRITE (I02,80002) IVTNUM 03750328
379: GO TO 0101 03760328
380: 20090 IVFAIL = IVFAIL + 1 03770328
381: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03780328
382: 0101 CONTINUE 03790328
383: C 03800328
384: C **** FCVS PROGRAM 328 - TEST 010 **** 03810328
385: C 03820328
386: C INTEGER AND REAL INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS03830328
387: C 03840328
388: IVTNUM = 10 03850328
389: IF (ICZERO) 30100, 0100, 30100 03860328
390: 0100 CONTINUE 03870328
391: RVON01 = 4.7 03880328
392: RVON02 = -5.2 03890328
393: CALL FS329(NINT(RVON01), ABS(RVON02), .TRUE.) 03900328
394: IVCOMP = 1 03910328
395: IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2 03920328
396: IF (RVCN01 .GE. 6.1995 .AND. RVCN01 .LE. 6.2005) IVCOMP = IVCOMP*303930328
397: IVCORR = 6 03940328
398: 40100 IF (IVCOMP - 6) 20100, 10100, 20100 03950328
399: 30100 IVDELE = IVDELE + 1 03960328
400: WRITE (I02,80000) IVTNUM 03970328
401: IF (ICZERO) 10100, 0111, 20100 03980328
402: 10100 IVPASS = IVPASS + 1 03990328
403: WRITE (I02,80002) IVTNUM 04000328
404: GO TO 0111 04010328
405: 20100 IVFAIL = IVFAIL + 1 04020328
406: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04030328
407: 0111 CONTINUE 04040328
408: C 04050328
409: C **** FCVS PROGRAM 328 - TEST 011 **** 04060328
410: C 04070328
411: C EXTERNAL FUNCTION REFERENCE AS ACTUAL ARGUMENT. 04080328
412: C 04090328
413: IVTNUM = 11 04100328
414: IF (ICZERO) 30110, 0110, 30110 04110328
415: 0110 CONTINUE 04120328
416: IVCOMP = 0 04130328
417: IVON01 = 4 04140328
418: CALL FS329(FF330(IVON01), 1.0, .TRUE.) 04150328
419: IVCOMP = IVCN01 04160328
420: IVCORR = 6 04170328
421: 40110 IF (IVCOMP - 6) 20110, 10110, 20110 04180328
422: 30110 IVDELE = IVDELE + 1 04190328
423: WRITE (I02,80000) IVTNUM 04200328
424: IF (ICZERO) 10110, 0121, 20110 04210328
425: 10110 IVPASS = IVPASS + 1 04220328
426: WRITE (I02,80002) IVTNUM 04230328
427: GO TO 0121 04240328
428: 20110 IVFAIL = IVFAIL + 1 04250328
429: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04260328
430: 0121 CONTINUE 04270328
431: C 04280328
432: C **** FCVS PROGRAM 328 - TEST 012 **** 04290328
433: C 04300328
434: C USE ACTUAL ARGUMENT NAMES WHICH ARE IDENTICAL TO THE DUMMY 04310328
435: C ARGUMENT NAMES. 04320328
436: C 04330328
437: IVTNUM = 12 04340328
438: IF (ICZERO) 30120, 0120, 30120 04350328
439: 0120 CONTINUE 04360328
440: IDON01 = 10 04370328
441: RDON01 = 10.0 04380328
442: LDON01 = .FALSE. 04390328
443: CALL FS329(IDON01, RDON01, LDON01) 04400328
444: IVCOMP = 1 04410328
445: IF (IVCN01 .EQ. 11) IVCOMP = IVCOMP * 2 04420328
446: IF (RVCN01 .GE. 10.995 .AND. RVCN01 .LE. 11.005) IVCOMP = IVCOMP*304430328
447: IF (LVCN01) IVCOMP = IVCOMP * 5 04440328
448: IVCORR = 30 04450328
449: 40120 IF (IVCOMP - 30) 20120, 10120, 20120 04460328
450: 30120 IVDELE = IVDELE + 1 04470328
451: WRITE (I02,80000) IVTNUM 04480328
452: IF (ICZERO) 10120, 0131, 20120 04490328
453: 10120 IVPASS = IVPASS + 1 04500328
454: WRITE (I02,80002) IVTNUM 04510328
455: GO TO 0131 04520328
456: 20120 IVFAIL = IVFAIL + 1 04530328
457: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04540328
458: 0131 CONTINUE 04550328
459: C 04560328
460: C **** FCVS PROGRAM 328 - TEST 013 **** 04570328
461: C 04580328
462: C USE INTEGER, REAL AND LOGICAL STATEMENT FUNCTION REFERENCES AS 04590328
463: C ARGUMENT NAMES. 04600328
464: C 04610328
465: IVTNUM = 13 04620328
466: IF (ICZERO) 30130, 0130, 30130 04630328
467: 0130 CONTINUE 04640328
468: RVON01 = 5.0 04650328
469: CALL FS329(IFOS01(4), RFOS01(RVON01), LFOS01(.TRUE.)) 04660328
470: IVCOMP = 1 04670328
471: IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2 04680328
472: IF (RVCN01 .GE. 6.9995 .AND. RVCN01 .LE. 7.0005) IVCOMP = IVCOMP*304690328
473: IF (LVCN01) IVCOMP = IVCOMP * 5 04700328
474: IVCORR = 30 04710328
475: 40130 IF (IVCOMP - 30) 20130, 10130, 20130 04720328
476: 30130 IVDELE = IVDELE + 1 04730328
477: WRITE (I02,80000) IVTNUM 04740328
478: IF (ICZERO) 10130, 0141, 20130 04750328
479: 10130 IVPASS = IVPASS + 1 04760328
480: WRITE (I02,80002) IVTNUM 04770328
481: GO TO 0141 04780328
482: 20130 IVFAIL = IVFAIL + 1 04790328
483: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04800328
484: 0141 CONTINUE 04810328
485: C 04820328
486: C TEST 014 THROUGH TEST 019 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 04830328
487: C OF ACTUAL ARGUMENTS TO ARRAY NAMES USED AS SUBROUTINE DUMMY 04840328
488: C ARGUMENTS. 04850328
489: C 04860328
490: C 04870328
491: C **** FCVS PROGRAM 328 - TEST 014 **** 04880328
492: C 04890328
493: C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 04900328
494: C ARGUMENT ARRAY DECLARATOR IS IDENTICAL TO THE ASSOCIATED DUMMY 04910328
495: C ARGUMENT ARRAY DECLARATOR. 04920328
496: C 04930328
497: IVTNUM = 14 04940328
498: IF (ICZERO) 30140, 0140, 30140 04950328
499: 0140 CONTINUE 04960328
500: IVCOMP = 0 04970328
501: IADN12(1) = 1 04980328
502: IADN12(2) = 10 04990328
503: IADN12(3) = 100 05000328
504: IADN12(4) = 1000 05010328
505: CALL FS331(IADN12) 05020328
506: IVCOMP = IVCN01 05030328
507: IVCORR = 1111 05040328
508: 40140 IF (IVCOMP - 1111) 20140, 10140, 20140 05050328
509: 30140 IVDELE = IVDELE + 1 05060328
510: WRITE (I02,80000) IVTNUM 05070328
511: IF (ICZERO) 10140, 0151, 20140 05080328
512: 10140 IVPASS = IVPASS + 1 05090328
513: WRITE (I02,80002) IVTNUM 05100328
514: GO TO 0151 05110328
515: 20140 IVFAIL = IVFAIL + 1 05120328
516: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05130328
517: 0151 CONTINUE 05140328
518: C 05150328
519: C **** FCVS PROGRAM 328 - TEST 015 **** 05160328
520: C 05170328
521: C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE OF THE 05180328
522: C ACTUAL ARGUMENT ARRAY IS LARGER THAN THE SIZE OF THE ASSOCIATED 05190328
523: C DUMMY ARGUMENT ARRAY. 05200328
524: C 05210328
525: IVTNUM = 15 05220328
526: IF (ICZERO) 30150, 0150, 30150 05230328
527: 0150 CONTINUE 05240328
528: IVCOMP = 0 05250328
529: IACN11(1) = 1 05260328
530: IACN11(2) = 10 05270328
531: IACN11(3) = 100 05280328
532: IACN11(4) = 1000 05290328
533: IACN11(5) = 10000 05300328
534: CALL FS331(IACN11) 05310328
535: IVCOMP = IVCN01 05320328
536: IVCORR = 1111 05330328
537: 40150 IF (IVCOMP - 1111) 20150, 10150, 20150 05340328
538: 30150 IVDELE = IVDELE + 1 05350328
539: WRITE (I02,80000) IVTNUM 05360328
540: IF (ICZERO) 10150, 0161, 20150 05370328
541: 10150 IVPASS = IVPASS + 1 05380328
542: WRITE (I02,80002) IVTNUM 05390328
543: GO TO 0161 05400328
544: 20150 IVFAIL = IVFAIL + 1 05410328
545: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05420328
546: 0161 CONTINUE 05430328
547: C 05440328
548: C **** FCVS PROGRAM 328 - TEST 016 **** 05450328
549: C 05460328
550: C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 05470328
551: C ARGUMENT ARRAY DECLARATOR IS LARGER AND HAS MORE SUBSCRIPT 05480328
552: C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR. 05490328
553: C 05500328
554: IVTNUM = 16 05510328
555: IF (ICZERO) 30160, 0160, 30160 05520328
556: 0160 CONTINUE 05530328
557: IVCOMP = 0 05540328
558: IATN11(1,1) = 1 05550328
559: IATN11(2,1) = 10 05560328
560: IATN11(1,2) = 100 05570328
561: IATN11(2,2) = 1000 05580328
562: IATN11(1,3) = 10000 05590328
563: CALL FS331(IATN11) 05600328
564: IVCOMP = IVCN01 05610328
565: IVCORR = 1111 05620328
566: 40160 IF (IVCOMP - 1111) 20160, 10160, 20160 05630328
567: 30160 IVDELE = IVDELE + 1 05640328
568: WRITE (I02,80000) IVTNUM 05650328
569: IF (ICZERO) 10160, 0171, 20160 05660328
570: 10160 IVPASS = IVPASS + 1 05670328
571: WRITE (I02,80002) IVTNUM 05680328
572: GO TO 0171 05690328
573: 20160 IVFAIL = IVFAIL + 1 05700328
574: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05710328
575: 0171 CONTINUE 05720328
576: C 05730328
577: C **** FCVS PROGRAM 328 - TEST 017 **** 05740328
578: C 05750328
579: C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE 05760328
580: C ASSOCIATED ACTUAL AND DUMMY ARRAY DECLARATORS ARE IDENTICAL. ALL 05770328
581: C ARRAY ELEMENTS OF THE ACTUAL ARRAY SHOULD BE PASSED TO THE 05780328
582: C DUMMY ARRAY OF THE SUBROUTINE. 05790328
583: C 05800328
584: IVTNUM = 17 05810328
585: IF (ICZERO) 30170, 0170, 30170 05820328
586: 0170 CONTINUE 05830328
587: RVCOMP = 0.0 05840328
588: RADN12(1) = 1. 05850328
589: RADN12(2) = 10. 05860328
590: RADN12(3) = 100. 05870328
591: RADN12(4) = 1000. 05880328
592: CALL FS332(RADN12(1)) 05890328
593: RVCOMP = RVCN01 05900328
594: RVCORR = 1111. 05910328
595: 40170 IF (RVCOMP - 1110.5) 20170, 10170, 40171 05920328
596: 40171 IF (RVCOMP - 1111.5) 10170, 10170, 20170 05930328
597: 30170 IVDELE = IVDELE + 1 05940328
598: WRITE (I02,80000) IVTNUM 05950328
599: IF (ICZERO) 10170, 0181, 20170 05960328
600: 10170 IVPASS = IVPASS + 1 05970328
601: WRITE (I02,80002) IVTNUM 05980328
602: GO TO 0181 05990328
603: 20170 IVFAIL = IVFAIL + 1 06000328
604: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06010328
605: 0181 CONTINUE 06020328
606: C 06030328
607: C **** FCVS PROGRAM 328 - TEST 018 **** 06040328
608: C 06050328
609: C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 06060328
610: C OF THE ACTUAL ARGUMENT ARRAY IS LARGER AND HAS FEWER SUBSCRIPT 06070328
611: C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARRAY. ONLY ACTUAL ARRAY 06080328
612: C ELEMENTS WITH SUBSCRIPT VALUES OF 5, 6, 7 AND 8 ( OUT OF A 06090328
613: C POSSIBLE 10 ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF 06100328
614: C THE SUBROUTINE. 06110328
615: C 06120328
616: IVTNUM = 18 06130328
617: IF (ICZERO) 30180, 0180, 30180 06140328
618: 0180 CONTINUE 06150328
619: RVCOMP = 0.0 06160328
620: RACN11(4) = 1. 06170328
621: RACN11(5) = 10. 06180328
622: RACN11(6) = 100. 06190328
623: RACN11(7) = 1000. 06200328
624: RACN11(8) = 10000. 06210328
625: RACN11(9) = 100000. 06220328
626: CALL FS332(RACN11(5)) 06230328
627: RVCOMP = RVCN01 06240328
628: RVCORR = 11110. 06250328
629: 40180 IF (RVCOMP - 11105.) 20180, 10180, 40181 06260328
630: 40181 IF (RVCOMP - 11115.) 10180, 10180, 20180 06270328
631: 30180 IVDELE = IVDELE + 1 06280328
632: WRITE (I02,80000) IVTNUM 06290328
633: IF (ICZERO) 10180, 0191, 20180 06300328
634: 10180 IVPASS = IVPASS + 1 06310328
635: WRITE (I02,80002) IVTNUM 06320328
636: GO TO 0191 06330328
637: 20180 IVFAIL = IVFAIL + 1 06340328
638: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06350328
639: 0191 CONTINUE 06360328
640: C 06370328
641: C **** FCVS PROGRAM 328 - TEST 019 **** 06380328
642: C 06390328
643: C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 06400328
644: C OF THE ACTUAL ARGUMENT ARRAY IS LARGE THAN THE SIZE OF THE 06410328
645: C ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL ARRAY ELEMENTS WITH 06420328
646: C SUBSCRIPT VALUES OF 9, 10, 11 AND 12 (OUT OF A POSSIBLE 12 06430328
647: C ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE SUBROUTINE. 06440328
648: C 06450328
649: IVTNUM = 19 06460328
650: IF (ICZERO) 30190, 0190, 30190 06470328
651: 0190 CONTINUE 06480328
652: RVCOMP = 0.0 06490328
653: RATN11(2,3) = 1. 06500328
654: RATN11(3,3) = 10. 06510328
655: RATN11(1,4) = 100. 06520328
656: RATN11(2,4) = 1000. 06530328
657: RATN11(3,4) = 10000. 06540328
658: CALL FS332(RATN11(3,3)) 06550328
659: RVCOMP = RVCN01 06560328
660: RVCORR = 11110. 06570328
661: 40190 IF (RVCOMP - 11105.) 20190, 10190, 40191 06580328
662: 40191 IF (RVCOMP - 11115.) 10190, 10190, 20190 06590328
663: 30190 IVDELE = IVDELE + 1 06600328
664: WRITE (I02,80000) IVTNUM 06610328
665: IF (ICZERO) 10190, 0201, 20190 06620328
666: 10190 IVPASS = IVPASS + 1 06630328
667: WRITE (I02,80002) IVTNUM 06640328
668: GO TO 0201 06650328
669: 20190 IVFAIL = IVFAIL + 1 06660328
670: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06670328
671: 0201 CONTINUE 06680328
672: C 06690328
673: C TEST 020 THROUGH TEST 022 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 06700328
674: C OF ACTUAL ARGUMENTS TO PROCEDURES USED AS SUBROUTINE DUMMY 06710328
675: C ARGUMENTS. ACTUAL ARGUMENTS TESTED INCLUDE THE NAMES OF AN 06720328
676: C EXTERNAL FUNCTION, AN INTRINSIC FUNCTION AND A SUBROUTINE. 06730328
677: C 06740328
678: C 06750328
679: C **** FCVS PROGRAM 328 - TEST 020 **** 06760328
680: C 06770328
681: C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT. 06780328
682: C 06790328
683: IVTNUM = 20 06800328
684: IF (ICZERO) 30200, 0200, 30200 06810328
685: 0200 CONTINUE 06820328
686: IVCOMP = 0 06830328
687: CALL FS333(FF330, 5) 06840328
688: IVCOMP = IVCN01 06850328
689: IVCORR = 7 06860328
690: 40200 IF (IVCOMP - 7) 20200, 10200, 20200 06870328
691: 30200 IVDELE = IVDELE + 1 06880328
692: WRITE (I02,80000) IVTNUM 06890328
693: IF (ICZERO) 10200, 0211, 20200 06900328
694: 10200 IVPASS = IVPASS + 1 06910328
695: WRITE (I02,80002) IVTNUM 06920328
696: GO TO 0211 06930328
697: 20200 IVFAIL = IVFAIL + 1 06940328
698: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06950328
699: 0211 CONTINUE 06960328
700: C 06970328
701: C **** FCVS PROGRAM 328 - TEST 021 **** 06980328
702: C 06990328
703: C USE AN INTRINSIC FUNCTION NAME AS AN ACTUAL ARGUMENT. 07000328
704: C 07010328
705: IVTNUM = 21 07020328
706: IF (ICZERO) 30210, 0210, 30210 07030328
707: 0210 CONTINUE 07040328
708: IVCOMP = 0 07050328
709: CALL FS333(IABS, -7) 07060328
710: IVCOMP = IVCN01 07070328
711: IVCORR = 8 07080328
712: 40210 IF (IVCOMP - 8) 20210, 10210, 20210 07090328
713: 30210 IVDELE = IVDELE + 1 07100328
714: WRITE (I02,80000) IVTNUM 07110328
715: IF (ICZERO) 10210, 0221, 20210 07120328
716: 10210 IVPASS = IVPASS + 1 07130328
717: WRITE (I02,80002) IVTNUM 07140328
718: GO TO 0221 07150328
719: 20210 IVFAIL = IVFAIL + 1 07160328
720: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07170328
721: 0221 CONTINUE 07180328
722: C 07190328
723: C **** FCVS PROGRAM 328 - TEST 022 **** 07200328
724: C 07210328
725: C USE A SUBROUTINE NAME AS AN ACTUAL ARGUMENT. 07220328
726: C 07230328
727: IVTNUM = 22 07240328
728: IF (ICZERO) 30220, 0220, 30220 07250328
729: 0220 CONTINUE 07260328
730: RVCOMP = 0.0 07270328
731: RVON01 = 3.5 07280328
732: CALL FS334(FS335, RVON01) 07290328
733: RVCOMP = RVCN01 07300328
734: RVCORR = 5.5 07310328
735: 40220 IF (RVCOMP - 5.4995) 20220, 10220, 40221 07320328
736: 40221 IF (RVCOMP - 5.5005) 10220, 10220, 20220 07330328
737: 30220 IVDELE = IVDELE + 1 07340328
738: WRITE (I02,80000) IVTNUM 07350328
739: IF (ICZERO) 10220, 0231, 20220 07360328
740: 10220 IVPASS = IVPASS + 1 07370328
741: WRITE (I02,80002) IVTNUM 07380328
742: GO TO 0231 07390328
743: 20220 IVFAIL = IVFAIL + 1 07400328
744: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07410328
745: 0231 CONTINUE 07420328
746: C 07430328
747: C 07440328
748: C WRITE OUT TEST SUMMARY 07450328
749: C 07460328
750: WRITE (I02,90004) 07470328
751: WRITE (I02,90014) 07480328
752: WRITE (I02,90004) 07490328
753: WRITE (I02,90000) 07500328
754: WRITE (I02,90004) 07510328
755: WRITE (I02,90020) IVFAIL 07520328
756: WRITE (I02,90022) IVPASS 07530328
757: WRITE (I02,90024) IVDELE 07540328
758: STOP 07550328
759: 90001 FORMAT (1H ,24X,5HFM328) 07560328
760: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM328) 07570328
761: C 07580328
762: C FORMATS FOR TEST DETAIL LINES 07590328
763: C 07600328
764: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 07610328
765: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 07620328
766: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 07630328
767: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 07640328
768: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 07650328
769: C 07660328
770: C FORMAT STATEMENTS FOR PAGE HEADERS 07670328
771: C 07680328
772: 90002 FORMAT (1H1) 07690328
773: 90004 FORMAT (1H ) 07700328
774: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 07710328
775: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 07720328
776: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 07730328
777: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 07740328
778: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 07750328
779: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 07760328
780: C 07770328
781: C FORMAT STATEMENTS FOR RUN SUMMARY 07780328
782: C 07790328
783: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 07800328
784: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 07810328
785: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 07820328
786: END 07830328
787: SUBROUTINE FS329(IDON01, RDON01, LDON01) 00010329
788: C DATE***82/08/02*18.33.46
789: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
790: C AUDIT FCVS78 V2.0
791: C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020329
792: C FM328 TO TEST THE DIFFERENT FORMS OF INTEGER, REAL AND LOGICAL 00030329
793: C ACTUAL ARGUMENTS THAT CAN BE ASSOCIATED WITH INTEGER, REAL AND 00040329
794: C LOGICAL DUMMY ARGUMENTS. THIS ROUTINE INCREMENTS THE INTEGER 00050329
795: C AND REAL ARGUMENTS BY ONE AND NEGATES THE LOGICAL ARGUMENT. ALL 00060329
796: C RESULTS ARE THEN RETURNED TO FM328 VIA VARIABLES IN NAMED COMMON. 00070329
797: IMPLICIT LOGICAL (L) 00080329
798: COMMON /BLK1/ IVCN01, RVCN01, LVCN01 00090329
799: IVCN01 = IDON01 + 1 00100329
800: RVCN01 = RDON01 + 1.0 00110329
801: LVCN01 = .NOT. LDON01 00120329
802: RETURN 00130329
803: END 00140329
804: INTEGER FUNCTION FF330(IDON02) 00010330
805: C DATE***82/08/02*18.33.46
806: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
807: C AUDIT FCVS78 V2.0
808: C THIS FUNCTION IS USED BY TEST 011 OF THE MAIN PROGRAM FM328 TO00020330
809: C TEST THE USE OF AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL 00030330
810: C ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS A VARIABLE NAME. 00040330
811: C THIS FUNCTION IS ALSO REFERENCED FROM SUBROUTINE FS333 VIA A 00050330
812: C DUMMY PROCEDURE NAME REFERENCE. THIS FUNCTION INCREMENTS THE 00060330
813: C ARGUMENT VALUE BY ONE AND RETURNS THE RESULT AS THE FUNCTION 00070330
814: C VALUE. 00080330
815: FF330 = IDON02 + 1 00090330
816: RETURN 00100330
817: END 00110330
818: SUBROUTINE FS331(IDDN11) 00010331
819: C DATE***82/08/02*18.33.46
820: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
821: C AUDIT FCVS78 V2.0
822: C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020331
823: C FM328 TO TEST THE USE OF AN ARRAY NAME AS AN ACTUAL ARGUMENT WHEN 00030331
824: C THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME. THIS ROUTINE 00040331
825: C ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY ARGUMENT ARRAY AND 00050331
826: C RETURNS THE RESULTS VIA A VARIABLE IN NAMED COMMON. 00060331
827: LOGICAL LVCN01 00070331
828: DIMENSION IDDN11(4) 00080331
829: COMMON /BLK1/IVCN01, RVCN01, LVCN01 00090331
830: IVCN01 = IDDN11(1) + IDDN11(2) + IDDN11(3) + IDDN11(4) 00100331
831: RETURN 00110331
832: END 00120331
833: SUBROUTINE FS332(RDTN21) 00010332
834: C DATE***82/08/02*18.33.46
835: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
836: C AUDIT FCVS78 V2.0
837: C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020332
838: C FM328 TO TEST THE USE OF AN ARRAY ELEMENT NAME AS AN ACTUAL 00030332
839: C ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME. 00040332
840: C THIS ROUTINE ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY 00050332
841: C ARGUMENT ARRAY AND RETURNS THE RESULT VIA A VARIABLE IN NAMED 00060332
842: C COMMON. 00070332
843: IMPLICIT LOGICAL (L) 00080332
844: REAL RDTN21(2,2) 00090332
845: COMMON /BLK1/IVCN01, RVCN01, LVCN01 00100332
846: RVCN01 = RDTN21(1,1) + RDTN21(2,1) + RDTN21(1,2) + RDTN21(2,2) 00110332
847: RETURN 00120332
848: END 00130332
849: SUBROUTINE FS333(NINT, IDON03) 00010333
850: C DATE***82/08/02*18.33.46
851: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
852: C AUDIT FCVS78 V2.0
853: C THIS SUBROUTINE IS USED BY TESTS 020 AND 021 OF THE MAIN 00020333
854: C PROGRAM FM328 TO TEST THE USE OF EXTERNAL AND INTRINSIC FUNCTION 00030333
855: C NAMES AS ACTUAL ARGUMENTS WHEN THE ASSOCIATED DUMMY ARGUMENT IS A 00040333
856: C PROCEDURE NAME. THIS SUBROUTINE REFERENCES THE EXTERNAL FUNCTION 00050333
857: C FF330 OR THE INTRINSIC FUNCTION IABS DEPENDING ON THE ACTUAL 00060333
858: C ARGUMENT PASSED TO IT. THE RESULT OF THIS FUNCTION REFERENCE IS 00070333
859: C THEN INCREMENTED BY ONE AND THE RESULT IS RETURNED TO FS328 VIA 00080333
860: C A VARIABLE IN NAMED COMMON. 00090333
861: IMPLICIT LOGICAL (L) 00100333
862: COMMON /BLK1/IVCN01, RVCN01, LVCN01 00110333
863: IVCN01 = NINT(IDON03) + 1 00120333
864: C **** THE NAME NINT IS A DUMMY ARGUMENT NAME 00130333
865: C AND NOT AN INTRINSIC FUNCTION REFERENCE **** 00140333
866: RETURN 00150333
867: END 00160333
868: SUBROUTINE FS334(IDON06, RDON03) 00010334
869: C DATE***82/08/02*18.33.46
870: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
871: C AUDIT FCVS78 V2.0
872: C THIS SUBROUTINE IS USED BY TEST 022 OF THE MAIN PROGRAM 00020334
873: C FM328 TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT 00030334
874: C WHEN THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME. THIS 00040334
875: C SUBROUTINE CALLS THE SUBROUTINE FS335 VIA A DUMMY PROCEDURE NAME 00050334
876: C REFERENCE. THE ARGUMENT VALUE WHICH IS RETURNED FROM THE FS335 00060334
877: C REFERENCE IS THEN INCREMENTED BY ONE AND RETURNED TO FM328 VIA 00070334
878: C A VARIABLE IN NAMED COMMON. 00080334
879: IMPLICIT LOGICAL (L) 00090334
880: COMMON /BLK1/IVCN01, RVCN01, LVCN01 00100334
881: CALL IDON06(RDON03) 00110334
882: RVCN01 = RDON03 + 1.0 00120334
883: RETURN 00130334
884: END 00140334
885: SUBROUTINE FS335(RDON04) 00010335
886: C DATE***82/08/02*18.33.46
887: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
888: C AUDIT FCVS78 V2.0
889: C THIS SUBROUITNE IS USED BY TEST 022 OF THE MAIN PROGRAM FM32800020335
890: C TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT WHEN 00030335
891: C THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME. FS335 IS 00040335
892: C CALLED FROM SUBROUTINE FS334 VIA A DUMMY PROCEDURE NAME REFERENCE.00050335
893: C THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY ONE. 00060335
894: RDON04 = RDON04 + 1.0 00070335
895: RETURN 00080335
896: END 00090335
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.