![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM317.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 FM317.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 FM317 00010317
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 00020317
6: C 00030317
7: C THIS ROUTINE TESTS SUBSET LEVEL FEATURES OF EXTERNAL 00040317
8: C FUNCTION SUBPROGRAMS. TESTS ARE DESIGNED TO CHECK THE 00050317
9: C ASSOCIATION OF ALL PERMISSIBLE FORMS OF ACTUAL ARGUMENTS WITH 00060317
10: C VARIABLE, ARRAY AND PROCEDURE NAME DUMMY ARGUMENTS. THESE 00070317
11: C INCLUDE, 00080317
12: C 00090317
13: C 1) ACTUAL ARGUMENTS ASSOCIATED TO VARIABLE NAME DUMMY 00100317
14: C ARGUMENT INCLUDE, 00110317
15: C 00120317
16: C A) CONSTANT 00130317
17: C B) VARIABLE NAME 00140317
18: C C) ARRAY ELEMENT NAME 00150317
19: C D) EXPRESSION INVOLVING OPERATORS 00160317
20: C E) EXPRESSION ENCLOSED IN PARENTHESES 00170317
21: C F) INTRINSIC FUNCTION REFERENCE 00180317
22: C G) EXTERNAL FUNCTION REFERENCE 00190317
23: C H) STATEMENT FUNCTION REFERENCE 00200317
24: C I) ACTUAL ARGUMENT NAME SAME AS DUMMY ARGUMENT NAME 00210317
25: C 00220317
26: C 2) ACTUAL ARGUMENTS ASSOCIATED TO ARRAY NAME DUMMY 00230317
27: C ARGUMENT INCLUDE, 00240317
28: C 00250317
29: C A) ARRAY NAME 00260317
30: C B) ARRAY ELEMENT NAME 00270317
31: C 00280317
32: C 3) ACTUAL ARGUMENTS ASSOCIATED TO PROCEDURE NAME DUMMY 00290317
33: C ARGUMENT INCLUDE, 00300317
34: C 00310317
35: C A) EXTERNAL FUNCTION NAME 00320317
36: C B) INTRINSIC FUNCTION NAME 00330317
37: C C) SUBROUTINE NAME 00340317
38: C 00350317
39: C SUBSET LEVEL ROUTINES FM028,FM050 AND FM080 ALSO TEST THE USE OF 00360317
40: C EXTERNAL FUNCTIONS. 00370317
41: C 00380317
42: C REFERENCES. 00390317
43: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00400317
44: C X3.9-1978 00410317
45: C 00420317
46: C SECTION 2.8, DUMMY ARGUMENTS 00430317
47: C SECTION 5.1.2.2, DUMMY ARRAY DECLARATOR 00440317
48: C SECTION 5.5, DUMMY AND ACTUAL ARRAYS 00450317
49: C SECTION 8.1, DIMENSION STATEMENT 00460317
50: C SECTION 8.3, COMMON STATEMENT 00470317
51: C SECTION 8.4, TYPE-STATEMENT 00480317
52: C SECTION 8.7, EXTERNAL STATEMENT 00490317
53: C SECTION 8.8, INTRINSIC STATEMENT 00500317
54: C SECTION 15.2, REFERENCING A FUNCTION 00510317
55: C SECTION 15.3, INTRINSIC FUNCTIONS 00520317
56: C SECTION 15.5, EXTERNAL FUNCTIONS 00530317
57: C SECTION 15.6, SUBROUTINES 00540317
58: C SECTION 15.9, ARGUMENTS AND COMMON BLOCKS 00550317
59: C 00560317
60: C 00570317
61: C ******************************************************************00580317
62: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00590317
63: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00600317
64: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00610317
65: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00620317
66: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00630317
67: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00640317
68: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00650317
69: C THE RESULT OF EXECUTING THESE TESTS. 00660317
70: C 00670317
71: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00680317
72: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00690317
73: C 00700317
74: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00710317
75: C DEPARTMENT OF THE NAVY 00720317
76: C FEDERAL COBOL COMPILER TESTING SERVICE 00730317
77: C WASHINGTON, D.C. 20376 00740317
78: C 00750317
79: C ******************************************************************00760317
80: C 00770317
81: C 00780317
82: IMPLICIT LOGICAL (L) 00790317
83: IMPLICIT CHARACTER*14 (C) 00800317
84: C 00810317
85: INTEGER FF318, FF321, FF322, FF324, FF325 00820317
86: LOGICAL FF320 00830317
87: INTRINSIC ABS, IABS, NINT 00840317
88: EXTERNAL FF318, FF321, FF325, FS327 00850317
89: DIMENSION IADN11(4), IADN12(4) 00860317
90: DIMENSION RADN11(4), RADN12(4) 00870317
91: DIMENSION LADN11(4) 00880317
92: COMMON IACN11(6), RACN11(10) 00890317
93: INTEGER IATN11(2,3) 00900317
94: REAL RATN11(3,4) 00910317
95: IFOS01(IDON04) = IDON04 + 1 00920317
96: C 00930317
97: C 00940317
98: C 00950317
99: C INITIALIZATION SECTION. 00960317
100: C 00970317
101: C INITIALIZE CONSTANTS 00980317
102: C ******************** 00990317
103: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01000317
104: I01 = 5 01010317
105: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01020317
106: I02 = 6 01030317
107: C SYSTEM ENVIRONMENT SECTION 01040317
108: C 01050317
109: I01 = 5 01060317
110: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01070317
111: C (UNIT NUMBER FOR CARD READER). 01080317
112: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01090317
113: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01100317
114: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01110317
115: C 01120317
116: I02 = 6 01130317
117: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01140317
118: C (UNIT NUMBER FOR PRINTER). 01150317
119: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01160317
120: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01170317
121: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01180317
122: C 01190317
123: IVPASS = 0 01200317
124: IVFAIL = 0 01210317
125: IVDELE = 0 01220317
126: ICZERO = 0 01230317
127: C 01240317
128: C WRITE OUT PAGE HEADERS 01250317
129: C 01260317
130: WRITE (I02,90002) 01270317
131: WRITE (I02,90006) 01280317
132: WRITE (I02,90008) 01290317
133: WRITE (I02,90004) 01300317
134: WRITE (I02,90010) 01310317
135: WRITE (I02,90004) 01320317
136: WRITE (I02,90016) 01330317
137: WRITE (I02,90001) 01340317
138: WRITE (I02,90004) 01350317
139: WRITE (I02,90012) 01360317
140: WRITE (I02,90014) 01370317
141: WRITE (I02,90004) 01380317
142: C 01390317
143: C 01400317
144: C TEST 001 THROUGH TEST 022 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 01410317
145: C OF ACTUAL ARGUMENTS TO VARIABLE NAMES USED AS EXTERNAL FUNCTION 01420317
146: C DUMMY ARGUMENTS. INTEGER, REAL AND LOGICAL DUMMY ARGUMENTS ARE 01430317
147: C TESTED. 01440317
148: C 01450317
149: C 01460317
150: C **** FCVS PROGRAM 317 - TEST 001 **** 01470317
151: C 01480317
152: C INTEGER CONSTANT AS ACTUAL ARGUMENT 01490317
153: C 01500317
154: IVTNUM = 1 01510317
155: IF (ICZERO) 30010, 0010, 30010 01520317
156: 0010 CONTINUE 01530317
157: IVCOMP = 0 01540317
158: IVCOMP = FF318(3) 01550317
159: IVCORR = 4 01560317
160: 40010 IF (IVCOMP - 4) 20010, 10010, 20010 01570317
161: 30010 IVDELE = IVDELE + 1 01580317
162: WRITE (I02,80000) IVTNUM 01590317
163: IF (ICZERO) 10010, 0021, 20010 01600317
164: 10010 IVPASS = IVPASS + 1 01610317
165: WRITE (I02,80002) IVTNUM 01620317
166: GO TO 0021 01630317
167: 20010 IVFAIL = IVFAIL + 1 01640317
168: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01650317
169: 0021 CONTINUE 01660317
170: C 01670317
171: C **** FCVS PROGRAM 317 - TEST 002 **** 01680317
172: C 01690317
173: C REAL CONSTANT AS ACTUAL ARGUMENT 01700317
174: C 01710317
175: IVTNUM = 2 01720317
176: IF (ICZERO) 30020, 0020, 30020 01730317
177: 0020 CONTINUE 01740317
178: RVCOMP = 0.0 01750317
179: RVCOMP = FF319(3.0) 01760317
180: RVCORR = 4.0 01770317
181: 40020 IF (RVCOMP - 3.9995) 20020, 10020, 40021 01780317
182: 40021 IF (RVCOMP - 4.0005) 10020, 10020, 20020 01790317
183: 30020 IVDELE = IVDELE + 1 01800317
184: WRITE (I02,80000) IVTNUM 01810317
185: IF (ICZERO) 10020, 0031, 20020 01820317
186: 10020 IVPASS = IVPASS + 1 01830317
187: WRITE (I02,80002) IVTNUM 01840317
188: GO TO 0031 01850317
189: 20020 IVFAIL = IVFAIL + 1 01860317
190: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01870317
191: 0031 CONTINUE 01880317
192: C 01890317
193: C **** FCVS PROGRAM 317 - TEST 003 **** 01900317
194: C 01910317
195: C LOGICAL CONSTANT AS ACTUAL ARGUMENT 01920317
196: C 01930317
197: IVTNUM = 3 01940317
198: IF (ICZERO) 30030, 0030, 30030 01950317
199: 0030 CONTINUE 01960317
200: IVCOMP = 0 01970317
201: IF (FF320(.FALSE.)) IVCOMP = 1 01980317
202: IVCORR = 1 01990317
203: 40030 IF (IVCOMP - 1) 20030, 10030, 20030 02000317
204: 30030 IVDELE = IVDELE + 1 02010317
205: WRITE (I02,80000) IVTNUM 02020317
206: IF (ICZERO) 10030, 0041, 20030 02030317
207: 10030 IVPASS = IVPASS + 1 02040317
208: WRITE (I02,80002) IVTNUM 02050317
209: GO TO 0041 02060317
210: 20030 IVFAIL = IVFAIL + 1 02070317
211: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02080317
212: 0041 CONTINUE 02090317
213: C 02100317
214: C **** FCVS PROGRAM 317 - TEST 004 **** 02110317
215: C 02120317
216: C INTEGER VARIABLE AS ACTUAL ARGUMENT 02130317
217: C 02140317
218: IVTNUM = 4 02150317
219: IF (ICZERO) 30040, 0040, 30040 02160317
220: 0040 CONTINUE 02170317
221: IVCOMP = 0 02180317
222: IVON01 = 7 02190317
223: IVCOMP = FF318(IVON01) 02200317
224: IVCORR = 8 02210317
225: 40040 IF (IVCOMP - 8) 20040, 10040, 20040 02220317
226: 30040 IVDELE = IVDELE + 1 02230317
227: WRITE (I02,80000) IVTNUM 02240317
228: IF (ICZERO) 10040, 0051, 20040 02250317
229: 10040 IVPASS = IVPASS + 1 02260317
230: WRITE (I02,80002) IVTNUM 02270317
231: GO TO 0051 02280317
232: 20040 IVFAIL = IVFAIL + 1 02290317
233: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02300317
234: 0051 CONTINUE 02310317
235: C 02320317
236: C **** FCVS PROGRAM 317 - TEST 005 **** 02330317
237: C 02340317
238: C REAL VARIABLE AS ACTUAL ARGUMENT 02350317
239: C 02360317
240: IVTNUM = 5 02370317
241: IF (ICZERO) 30050, 0050, 30050 02380317
242: 0050 CONTINUE 02390317
243: RVCOMP = 0.0 02400317
244: RVON01 = 7.0 02410317
245: RVCOMP = FF319(RVON01) 02420317
246: RVCORR = 8.0 02430317
247: 40050 IF (RVCOMP - 7.9995) 20050, 10050, 40051 02440317
248: 40051 IF (RVCOMP - 8.0005) 10050, 10050, 20050 02450317
249: 30050 IVDELE = IVDELE + 1 02460317
250: WRITE (I02,80000) IVTNUM 02470317
251: IF (ICZERO) 10050, 0061, 20050 02480317
252: 10050 IVPASS = IVPASS + 1 02490317
253: WRITE (I02,80002) IVTNUM 02500317
254: GO TO 0061 02510317
255: 20050 IVFAIL = IVFAIL + 1 02520317
256: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02530317
257: 0061 CONTINUE 02540317
258: C 02550317
259: C **** FCVS PROGRAM 317 - TEST 006 **** 02560317
260: C 02570317
261: C LOGICAL VARIABLE AS ACTUAL ARGUMENT 02580317
262: C 02590317
263: IVTNUM = 6 02600317
264: IF (ICZERO) 30060, 0060, 30060 02610317
265: 0060 CONTINUE 02620317
266: LVON01 = .TRUE. 02630317
267: IVCOMP = 0 02640317
268: IF (.NOT. FF320(LVON01)) IVCOMP = 1 02650317
269: IVCORR = 1 02660317
270: 40060 IF (IVCOMP - 1) 20060, 10060, 20060 02670317
271: 30060 IVDELE = IVDELE + 1 02680317
272: WRITE (I02,80000) IVTNUM 02690317
273: IF (ICZERO) 10060, 0071, 20060 02700317
274: 10060 IVPASS = IVPASS + 1 02710317
275: WRITE (I02,80002) IVTNUM 02720317
276: GO TO 0071 02730317
277: 20060 IVFAIL = IVFAIL + 1 02740317
278: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02750317
279: 0071 CONTINUE 02760317
280: C 02770317
281: C **** FCVS PROGRAM 317 - TEST 007 **** 02780317
282: C 02790317
283: C INTEGER ARRAY ELEMENT NAME AS ACTUAL ARGUMENT 02800317
284: C 02810317
285: IVTNUM = 7 02820317
286: IF (ICZERO) 30070, 0070, 30070 02830317
287: 0070 CONTINUE 02840317
288: IVCOMP = 0 02850317
289: IADN11(2) = 2 02860317
290: IVCOMP = FF318(IADN11(2)) 02870317
291: IVCORR = 3 02880317
292: 40070 IF (IVCOMP - 3) 20070, 10070, 20070 02890317
293: 30070 IVDELE = IVDELE + 1 02900317
294: WRITE (I02,80000) IVTNUM 02910317
295: IF (ICZERO) 10070, 0081, 20070 02920317
296: 10070 IVPASS = IVPASS + 1 02930317
297: WRITE (I02,80002) IVTNUM 02940317
298: GO TO 0081 02950317
299: 20070 IVFAIL = IVFAIL + 1 02960317
300: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02970317
301: 0081 CONTINUE 02980317
302: C 02990317
303: C **** FCVS PROGRAM 317 - TEST 008 **** 03000317
304: C 03010317
305: C REAL ARRAY ELEMENT NAME AS ACTUAL ARGUMENT 03020317
306: C 03030317
307: IVTNUM = 8 03040317
308: IF (ICZERO) 30080, 0080, 30080 03050317
309: 0080 CONTINUE 03060317
310: RVCOMP = 0.0 03070317
311: RADN11(4) = 4.0 03080317
312: RVCOMP = FF319(RADN11(4)) 03090317
313: RVCORR = 5.0 03100317
314: 40080 IF (RVCOMP - 4.9995) 20080, 10080, 40081 03110317
315: 40081 IF (RVCOMP - 5.0005) 10080, 10080, 20080 03120317
316: 30080 IVDELE = IVDELE + 1 03130317
317: WRITE (I02,80000) IVTNUM 03140317
318: IF (ICZERO) 10080, 0091, 20080 03150317
319: 10080 IVPASS = IVPASS + 1 03160317
320: WRITE (I02,80002) IVTNUM 03170317
321: GO TO 0091 03180317
322: 20080 IVFAIL = IVFAIL + 1 03190317
323: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03200317
324: 0091 CONTINUE 03210317
325: C 03220317
326: C **** FCVS PROGRAM 317 - TEST 009 **** 03230317
327: C 03240317
328: C LOGICAL ARRAY ELEMENT NAME AS ACTUAL ARGUMENT 03250317
329: C 03260317
330: IVTNUM = 9 03270317
331: IF (ICZERO) 30090, 0090, 30090 03280317
332: 0090 CONTINUE 03290317
333: LADN11(1) = .FALSE. 03300317
334: IVCOMP = 0 03310317
335: IF (FF320(LADN11(1))) IVCOMP = 1 03320317
336: IVCORR = 1 03330317
337: 40090 IF (IVCOMP - 1) 20090, 10090, 20090 03340317
338: 30090 IVDELE = IVDELE + 1 03350317
339: WRITE (I02,80000) IVTNUM 03360317
340: IF (ICZERO) 10090, 0101, 20090 03370317
341: 10090 IVPASS = IVPASS + 1 03380317
342: WRITE (I02,80002) IVTNUM 03390317
343: GO TO 0101 03400317
344: 20090 IVFAIL = IVFAIL + 1 03410317
345: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03420317
346: 0101 CONTINUE 03430317
347: C 03440317
348: C **** FCVS PROGRAM 317 - TEST 010 **** 03450317
349: C 03460317
350: C INTEGER EXPRESSION INVOLVING OPERATORS AS ACTUAL ARGUMENT 03470317
351: C 03480317
352: IVTNUM = 10 03490317
353: IF (ICZERO) 30100, 0100, 30100 03500317
354: 0100 CONTINUE 03510317
355: IVCOMP = 0 03520317
356: IVON02 = 2 03530317
357: IVON03 = 3 03540317
358: IVCOMP = FF318(IVON02 + 3 * IVON03 - 7) 03550317
359: IVCORR = 5 03560317
360: 40100 IF (IVCOMP - 5) 20100, 10100, 20100 03570317
361: 30100 IVDELE = IVDELE + 1 03580317
362: WRITE (I02,80000) IVTNUM 03590317
363: IF (ICZERO) 10100, 0111, 20100 03600317
364: 10100 IVPASS = IVPASS + 1 03610317
365: WRITE (I02,80002) IVTNUM 03620317
366: GO TO 0111 03630317
367: 20100 IVFAIL = IVFAIL + 1 03640317
368: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03650317
369: 0111 CONTINUE 03660317
370: C 03670317
371: C **** FCVS PROGRAM 317 - TEST 011 **** 03680317
372: C 03690317
373: C REAL EXPRESSION INVOLVING OPERATORS AS ACTUAL ARGUMENT 03700317
374: C 03710317
375: IVTNUM = 11 03720317
376: IF (ICZERO) 30110, 0110, 30110 03730317
377: 0110 CONTINUE 03740317
378: RVCOMP = 0.0 03750317
379: RVON02 = 2. 03760317
380: RVON03 = 1.2 03770317
381: RVCOMP = FF319(RVON02 * RVON03 /.6) 03780317
382: RVCORR = 5.0 03790317
383: 40110 IF (RVCOMP - 4.9995) 20110, 10110, 40111 03800317
384: 40111 IF (RVCOMP - 5.0005) 10110, 10110, 20110 03810317
385: 30110 IVDELE = IVDELE + 1 03820317
386: WRITE (I02,80000) IVTNUM 03830317
387: IF (ICZERO) 10110, 0121, 20110 03840317
388: 10110 IVPASS = IVPASS + 1 03850317
389: WRITE (I02,80002) IVTNUM 03860317
390: GO TO 0121 03870317
391: 20110 IVFAIL = IVFAIL + 1 03880317
392: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03890317
393: 0121 CONTINUE 03900317
394: C 03910317
395: C **** FCVS PROGRAM 317 - TEST 012 **** 03920317
396: C 03930317
397: C REAL EXPRESSION INVOLVING INTEGER AND REAL PRIMARIES AND OPERATORS03940317
398: C AS ACTUAL ARGUMENT. 03950317
399: C 03960317
400: IVTNUM = 12 03970317
401: IF (ICZERO) 30120, 0120, 30120 03980317
402: 0120 CONTINUE 03990317
403: RVCOMP = 0.0 04000317
404: IVON01 = 2 04010317
405: RADN11(2) = 2.5 04020317
406: RVCOMP = FF319(IVON01**3 * (RADN11(2) - 1) + 2.0) 04030317
407: RVCORR = 15.0 04040317
408: 40120 IF (RVCOMP - 14.995) 20120, 10120, 40121 04050317
409: 40121 IF (RVCOMP - 15.005) 10120, 10120, 20120 04060317
410: 30120 IVDELE = IVDELE + 1 04070317
411: WRITE (I02,80000) IVTNUM 04080317
412: IF (ICZERO) 10120, 0131, 20120 04090317
413: 10120 IVPASS = IVPASS + 1 04100317
414: WRITE (I02,80002) IVTNUM 04110317
415: GO TO 0131 04120317
416: 20120 IVFAIL = IVFAIL + 1 04130317
417: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04140317
418: 0131 CONTINUE 04150317
419: C 04160317
420: C **** FCVS PROGRAM 317 - TEST 013 **** 04170317
421: C 04180317
422: C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.NOT.) AS ACTUAL 04190317
423: C ARGUMENT. 04200317
424: C 04210317
425: IVTNUM = 13 04220317
426: IF (ICZERO) 30130, 0130, 30130 04230317
427: 0130 CONTINUE 04240317
428: LVON01 = .TRUE. 04250317
429: IVCOMP = 0 04260317
430: IF (FF320(.NOT. LVON01)) IVCOMP = 1 04270317
431: IVCORR = 1 04280317
432: 40130 IF (IVCOMP - 1) 20130, 10130, 20130 04290317
433: 30130 IVDELE = IVDELE + 1 04300317
434: WRITE (I02,80000) IVTNUM 04310317
435: IF (ICZERO) 10130, 0141, 20130 04320317
436: 10130 IVPASS = IVPASS + 1 04330317
437: WRITE (I02,80002) IVTNUM 04340317
438: GO TO 0141 04350317
439: 20130 IVFAIL = IVFAIL + 1 04360317
440: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04370317
441: 0141 CONTINUE 04380317
442: C 04390317
443: C **** FCVS PROGRAM 317 - TEST 014 **** 04400317
444: C 04410317
445: C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.OR.) AS ACTIVE 04420317
446: C ARGUMENT. 04430317
447: C 04440317
448: IVTNUM = 14 04450317
449: IF (ICZERO) 30140, 0140, 30140 04460317
450: 0140 CONTINUE 04470317
451: LVON01 = .TRUE. 04480317
452: LVON02 = .FALSE. 04490317
453: IVCOMP = 0 04500317
454: IF (.NOT. FF320(LVON01 .OR. LVON02)) IVCOMP = 1 04510317
455: IVCORR = 1 04520317
456: 40140 IF (IVCOMP - 1) 20140, 10140, 20140 04530317
457: 30140 IVDELE = IVDELE + 1 04540317
458: WRITE (I02,80000) IVTNUM 04550317
459: IF (ICZERO) 10140, 0151, 20140 04560317
460: 10140 IVPASS = IVPASS + 1 04570317
461: WRITE (I02,80002) IVTNUM 04580317
462: GO TO 0151 04590317
463: 20140 IVFAIL = IVFAIL + 1 04600317
464: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04610317
465: 0151 CONTINUE 04620317
466: C 04630317
467: C **** FCVS PROGRAM 317 - TEST 015 **** 04640317
468: C 04650317
469: C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.AND.) AS ACTUAL 04660317
470: C ARGUMENT. 04670317
471: C 04680317
472: IVTNUM = 15 04690317
473: IF (ICZERO) 30150, 0150, 30150 04700317
474: 0150 CONTINUE 04710317
475: LVON01 = .FALSE. 04720317
476: LVON02 = .TRUE. 04730317
477: IVCOMP = 0 04740317
478: IF (FF320(LVON01 .AND. LVON02)) IVCOMP = 1 04750317
479: IVCORR = 1 04760317
480: 40150 IF (IVCOMP - 1) 20150, 10150, 20150 04770317
481: 30150 IVDELE = IVDELE + 1 04780317
482: WRITE (I02,80000) IVTNUM 04790317
483: IF (ICZERO) 10150, 0161, 20150 04800317
484: 10150 IVPASS = IVPASS + 1 04810317
485: WRITE (I02,80002) IVTNUM 04820317
486: GO TO 0161 04830317
487: 20150 IVFAIL = IVFAIL + 1 04840317
488: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04850317
489: 0161 CONTINUE 04860317
490: C 04870317
491: C **** FCVS PROGRAM 317 - TEST 016 **** 04880317
492: C 04890317
493: C EXPRESSION ENCLOSED IN PARENTHESES AS ACTUAL ARGUMENT 04900317
494: C 04910317
495: IVTNUM = 16 04920317
496: IF (ICZERO) 30160, 0160, 30160 04930317
497: 0160 CONTINUE 04940317
498: IVCOMP = 0 04950317
499: IVON01 = 6 04960317
500: IVCOMP = FF318((IVON01 + 3)) 04970317
501: IVCORR = 10 04980317
502: 40160 IF (IVCOMP - 10) 20160, 10160, 20160 04990317
503: 30160 IVDELE = IVDELE + 1 05000317
504: WRITE (I02,80000) IVTNUM 05010317
505: IF (ICZERO) 10160, 0171, 20160 05020317
506: 10160 IVPASS = IVPASS + 1 05030317
507: WRITE (I02,80002) IVTNUM 05040317
508: GO TO 0171 05050317
509: 20160 IVFAIL = IVFAIL + 1 05060317
510: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05070317
511: 0171 CONTINUE 05080317
512: C 05090317
513: C **** FCVS PROGRAM 317 - TEST 017 **** 05100317
514: C 05110317
515: C REAL INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT. 05120317
516: C 05130317
517: IVTNUM = 17 05140317
518: IF (ICZERO) 30170, 0170, 30170 05150317
519: 0170 CONTINUE 05160317
520: RVCOMP = 0.0 05170317
521: RVON01 = -5.2 05180317
522: RVCOMP = FF319(ABS(RVON01)) 05190317
523: RVCORR = 6.2 05200317
524: 40170 IF (RVCOMP - 6.1995) 20170, 10170, 40171 05210317
525: 40171 IF (RVCOMP - 6.2005) 10170, 10170, 20170 05220317
526: 30170 IVDELE = IVDELE + 1 05230317
527: WRITE (I02,80000) IVTNUM 05240317
528: IF (ICZERO) 10170, 0181, 20170 05250317
529: 10170 IVPASS = IVPASS + 1 05260317
530: WRITE (I02,80002) IVTNUM 05270317
531: GO TO 0181 05280317
532: 20170 IVFAIL = IVFAIL + 1 05290317
533: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05300317
534: 0181 CONTINUE 05310317
535: C 05320317
536: C **** FCVS PROGRAM 317 - TEST 018 **** 05330317
537: C 05340317
538: C INTEGER INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT. 05350317
539: C 05360317
540: IVTNUM = 18 05370317
541: IF (ICZERO) 30180, 0180, 30180 05380317
542: 0180 CONTINUE 05390317
543: IVCOMP = 0 05400317
544: RVON01 = 4.7 05410317
545: IVCOMP = FF318(NINT(RVON01)) 05420317
546: IVCORR = 6 05430317
547: 40180 IF (IVCOMP - 6) 20180, 10180, 20180 05440317
548: 30180 IVDELE = IVDELE + 1 05450317
549: WRITE (I02,80000) IVTNUM 05460317
550: IF (ICZERO) 10180, 0191, 20180 05470317
551: 10180 IVPASS = IVPASS + 1 05480317
552: WRITE (I02,80002) IVTNUM 05490317
553: GO TO 0191 05500317
554: 20180 IVFAIL = IVFAIL + 1 05510317
555: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05520317
556: 0191 CONTINUE 05530317
557: C 05540317
558: C **** FCVS PROGRAM 317 - TEST 019 **** 05550317
559: C 05560317
560: C EXTERNAL FUNCTION REFERENCE AS ACTUAL ARGUMENT. 05570317
561: C 05580317
562: IVTNUM = 19 05590317
563: IF (ICZERO) 30190, 0190, 30190 05600317
564: 0190 CONTINUE 05610317
565: IVCOMP = 0 05620317
566: IVON01 = 4 05630317
567: IVCOMP = FF318(FF321(IVON01)) 05640317
568: IVCORR = 6 05650317
569: 40190 IF (IVCOMP - 6) 20190, 10190, 20190 05660317
570: 30190 IVDELE = IVDELE + 1 05670317
571: WRITE (I02,80000) IVTNUM 05680317
572: IF (ICZERO) 10190, 0201, 20190 05690317
573: 10190 IVPASS = IVPASS + 1 05700317
574: WRITE (I02,80002) IVTNUM 05710317
575: GO TO 0201 05720317
576: 20190 IVFAIL = IVFAIL + 1 05730317
577: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05740317
578: 0201 CONTINUE 05750317
579: C 05760317
580: C **** FCVS PROGRAM 317 - TEST 020 **** 05770317
581: C 05780317
582: C EXTERNAL FUNCTION REFERENCE WHICH USES A REFERENCE TO ITSELF 05790317
583: C AS AN ACTUAL ARGUMENT. 05800317
584: C 05810317
585: IVTNUM = 20 05820317
586: IF (ICZERO) 30200, 0200, 30200 05830317
587: 0200 CONTINUE 05840317
588: IVCOMP = 0 05850317
589: IVCOMP = FF318(FF318(4)) 05860317
590: IVCORR = 6 05870317
591: 40200 IF (IVCOMP - 6) 20200, 10200, 20200 05880317
592: 30200 IVDELE = IVDELE + 1 05890317
593: WRITE (I02,80000) IVTNUM 05900317
594: IF (ICZERO) 10200, 0211, 20200 05910317
595: 10200 IVPASS = IVPASS + 1 05920317
596: WRITE (I02,80002) IVTNUM 05930317
597: GO TO 0211 05940317
598: 20200 IVFAIL = IVFAIL + 1 05950317
599: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05960317
600: 0211 CONTINUE 05970317
601: C 05980317
602: C **** FCVS PROGRAM 317 - TEST 021 **** 05990317
603: C 06000317
604: C USE AN ACTUAL ARGUMENT NAME WHICH IS IDENTICAL TO THE DUMMY 06010317
605: C ARGUMENT NAME. 06020317
606: C 06030317
607: IVTNUM = 21 06040317
608: IF (ICZERO) 30210, 0210, 30210 06050317
609: 0210 CONTINUE 06060317
610: IVCOMP = 0 06070317
611: IDON01 = 10 06080317
612: IVCOMP = FF318(IDON01) 06090317
613: IVCORR = 11 06100317
614: 40210 IF (IVCOMP - 11) 20210, 10210, 20210 06110317
615: 30210 IVDELE = IVDELE + 1 06120317
616: WRITE (I02,80000) IVTNUM 06130317
617: IF (ICZERO) 10210, 0221, 20210 06140317
618: 10210 IVPASS = IVPASS + 1 06150317
619: WRITE (I02,80002) IVTNUM 06160317
620: GO TO 0221 06170317
621: 20210 IVFAIL = IVFAIL + 1 06180317
622: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06190317
623: 0221 CONTINUE 06200317
624: C 06210317
625: C **** FCVS PROGRAM 317 - TEST 022 **** 06220317
626: C 06230317
627: C USE STATEMENT FUNCTION REFERENCE AS ACTUAL ARGUMENT. 06240317
628: C 06250317
629: IVTNUM = 22 06260317
630: IF (ICZERO) 30220, 0220, 30220 06270317
631: 0220 CONTINUE 06280317
632: IVCOMP = 0 06290317
633: IVCOMP = FF318(IFOS01(4)) 06300317
634: IVCORR = 6 06310317
635: 40220 IF (IVCOMP - 6) 20220, 10220, 20220 06320317
636: 30220 IVDELE = IVDELE + 1 06330317
637: WRITE (I02,80000) IVTNUM 06340317
638: IF (ICZERO) 10220, 0231, 20220 06350317
639: 10220 IVPASS = IVPASS + 1 06360317
640: WRITE (I02,80002) IVTNUM 06370317
641: GO TO 0231 06380317
642: 20220 IVFAIL = IVFAIL + 1 06390317
643: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06400317
644: 0231 CONTINUE 06410317
645: C 06420317
646: C TEST 023 THROUGH TEST 028 ARE DESIGNED TO ASSOCIATE VARIOUS 06430317
647: C FORMS OF ACTUAL ARGUMENTS TO ARRAY NAMES USED AS EXTERNAL 06440317
648: C FUNCTION DUMMY ARGUMENTS. 06450317
649: C 06460317
650: C 06470317
651: C **** FCVS PROGRAM 317 - TEST 023 **** 06480317
652: C 06490317
653: C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 06500317
654: C ARGUMENT ARRAY DECLARATOR IS IDENTICAL TO THE ASSOCIATED DUMMY 06510317
655: C ARGUMENT ARRAY DECLARATOR. 06520317
656: C 06530317
657: IVTNUM = 23 06540317
658: IF (ICZERO) 30230, 0230, 30230 06550317
659: 0230 CONTINUE 06560317
660: IVCOMP = 0 06570317
661: IADN12(1) = 1 06580317
662: IADN12(2) = 10 06590317
663: IADN12(3) = 100 06600317
664: IADN12(4) = 1000 06610317
665: IVCOMP = FF322(IADN12) 06620317
666: IVCORR = 1111 06630317
667: 40230 IF (IVCOMP - 1111) 20230, 10230, 20230 06640317
668: 30230 IVDELE = IVDELE + 1 06650317
669: WRITE (I02,80000) IVTNUM 06660317
670: IF (ICZERO) 10230, 0241, 20230 06670317
671: 10230 IVPASS = IVPASS + 1 06680317
672: WRITE (I02,80002) IVTNUM 06690317
673: GO TO 0241 06700317
674: 20230 IVFAIL = IVFAIL + 1 06710317
675: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06720317
676: 0241 CONTINUE 06730317
677: C 06740317
678: C **** FCVS PROGRAM 317 - TEST 024 **** 06750317
679: C 06760317
680: C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE OF THE 06770317
681: C ACTUAL ARGUMENT ARRAY IS LARGER THAN THE SIZE OF THE ASSOCIATED 06780317
682: C DUMMY ARGUMENT ARRAY. 06790317
683: C 06800317
684: IVTNUM = 24 06810317
685: IF (ICZERO) 30240, 0240, 30240 06820317
686: 0240 CONTINUE 06830317
687: IVCOMP = 0 06840317
688: IACN11(1) = 1 06850317
689: IACN11(2) = 10 06860317
690: IACN11(3) = 100 06870317
691: IACN11(4) = 1000 06880317
692: IACN11(5) = 10000 06890317
693: IVCOMP = FF322(IACN11) 06900317
694: IVCORR = 1111 06910317
695: 40240 IF (IVCOMP - 1111) 20240, 10240, 20240 06920317
696: 30240 IVDELE = IVDELE + 1 06930317
697: WRITE (I02,80000) IVTNUM 06940317
698: IF (ICZERO) 10240, 0251, 20240 06950317
699: 10240 IVPASS = IVPASS + 1 06960317
700: WRITE (I02,80002) IVTNUM 06970317
701: GO TO 0251 06980317
702: 20240 IVFAIL = IVFAIL + 1 06990317
703: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07000317
704: 0251 CONTINUE 07010317
705: C 07020317
706: C **** FCVS PROGRAM 317 - TEST 025 **** 07030317
707: C 07040317
708: C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 07050317
709: C ARGUMENT ARRAY DECLARATOR IS LARGER AND HAS MORE SUBSCRIPT 07060317
710: C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR. 07070317
711: C THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR. 07080317
712: C 07090317
713: IVTNUM = 25 07100317
714: IF (ICZERO) 30250, 0250, 30250 07110317
715: 0250 CONTINUE 07120317
716: IVCOMP = 0 07130317
717: IATN11(1,1) = 1 07140317
718: IATN11(2,1) = 10 07150317
719: IATN11(1,2) = 100 07160317
720: IATN11(2,2) = 1000 07170317
721: IATN11(1,3) = 10000 07180317
722: IVCOMP = FF322(IATN11) 07190317
723: IVCORR = 1111 07200317
724: 40250 IF (IVCOMP - 1111) 20250, 10250, 20250 07210317
725: 30250 IVDELE = IVDELE + 1 07220317
726: WRITE (I02,80000) IVTNUM 07230317
727: IF (ICZERO) 10250, 0261, 20250 07240317
728: 10250 IVPASS = IVPASS + 1 07250317
729: WRITE (I02,80002) IVTNUM 07260317
730: GO TO 0261 07270317
731: 20250 IVFAIL = IVFAIL + 1 07280317
732: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07290317
733: 0261 CONTINUE 07300317
734: C 07310317
735: C **** FCVS PROGRAM 317 - TEST 026 **** 07320317
736: C 07330317
737: C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE 07340317
738: C ASSOCIATED ACTUAL AND DUMMY ARRAY DECLARATORS ARE IDENTICAL. ALL 07350317
739: C ARRAY ELEMENTS OF THE ACTUAL ARRAY SHOULD BE PASSED TO THE 07360317
740: C DUMMY ARRAY OF THE EXTERNAL FUNCTION. 07370317
741: C 07380317
742: IVTNUM = 26 07390317
743: IF (ICZERO) 30260, 0260, 30260 07400317
744: 0260 CONTINUE 07410317
745: RVCOMP = 0.0 07420317
746: RADN12(1) = 1. 07430317
747: RADN12(2) = 10. 07440317
748: RADN12(3) = 100. 07450317
749: RADN12(4) = 1000. 07460317
750: RVCOMP = FF323(RADN12(1)) 07470317
751: RVCORR = 1111. 07480317
752: 40260 IF (RVCOMP - 1110.5) 20260, 10260, 40261 07490317
753: 40261 IF (RVCOMP - 1111.5) 10260, 10260, 20260 07500317
754: 30260 IVDELE = IVDELE + 1 07510317
755: WRITE (I02,80000) IVTNUM 07520317
756: IF (ICZERO) 10260, 0271, 20260 07530317
757: 10260 IVPASS = IVPASS + 1 07540317
758: WRITE (I02,80002) IVTNUM 07550317
759: GO TO 0271 07560317
760: 20260 IVFAIL = IVFAIL + 1 07570317
761: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07580317
762: 0271 CONTINUE 07590317
763: C 07600317
764: C **** FCVS PROGRAM 317 - TEST 027 **** 07610317
765: C 07620317
766: C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 07630317
767: C OF THE ACTUAL ARGUMENT ARRAY IS LARGER AND HAS FEWER SUBSCRIPT 07640317
768: C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL07650317
769: C ARRAY ELEMENTS WITH SUBSCRIPT VALUES OF 5, 6, 7 AND 8 (OUT OF A 07660317
770: C POSSIBLE 10 ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE 07670317
771: C EXTERNAL FUNCTION. 07680317
772: C 07690317
773: IVTNUM = 27 07700317
774: IF (ICZERO) 30270, 0270, 30270 07710317
775: 0270 CONTINUE 07720317
776: RVCOMP = 0.0 07730317
777: RACN11(4) = 1. 07740317
778: RACN11(5) = 10. 07750317
779: RACN11(6) = 100. 07760317
780: RACN11(7) = 1000. 07770317
781: RACN11(8) = 10000. 07780317
782: RACN11(9) = 100000. 07790317
783: RVCORR = 11110. 07800317
784: RVCOMP = FF323(RACN11(5)) 07810317
785: 40270 IF (RVCOMP - 11105.) 20270, 10270, 40271 07820317
786: 40271 IF (RVCOMP - 11115.) 10270, 10270, 20270 07830317
787: 30270 IVDELE = IVDELE + 1 07840317
788: WRITE (I02,80000) IVTNUM 07850317
789: IF (ICZERO) 10270, 0281, 20270 07860317
790: 10270 IVPASS = IVPASS + 1 07870317
791: WRITE (I02,80002) IVTNUM 07880317
792: GO TO 0281 07890317
793: 20270 IVFAIL = IVFAIL + 1 07900317
794: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07910317
795: 0281 CONTINUE 07920317
796: C 07930317
797: C **** FCVS PROGRAM 317 - TEST 028 **** 07940317
798: C 07950317
799: C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 07960317
800: C OF THE ACTUAL ARGUMENT ARRAY IS LARGE THAN THE SIZE OF THE 07970317
801: C ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL ARRAY ELEMENTS WITH 07980317
802: C SUBSCRIPT VALUES OF 9, 10, 11 AND 12 (OUT OF A POSSIBLE 12 07990317
803: C ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE EXTERNAL 08000317
804: C FUNCTION. 08010317
805: C 08020317
806: IVTNUM = 28 08030317
807: IF (ICZERO) 30280, 0280, 30280 08040317
808: 0280 CONTINUE 08050317
809: RVCOMP = 0.0 08060317
810: RATN11(2,3) = 1. 08070317
811: RATN11(3,3) = 10. 08080317
812: RATN11(1,4) = 100. 08090317
813: RATN11(2,4) = 1000. 08100317
814: RATN11(3,4) = 10000. 08110317
815: RVCOMP = FF323(RATN11(3,3)) 08120317
816: RVCORR = 11110. 08130317
817: 40280 IF (RVCOMP - 11105.) 20280, 10280, 40281 08140317
818: 40281 IF (RVCOMP - 11115.) 10280, 10280, 20280 08150317
819: 30280 IVDELE = IVDELE + 1 08160317
820: WRITE (I02,80000) IVTNUM 08170317
821: IF (ICZERO) 10280, 0291, 20280 08180317
822: 10280 IVPASS = IVPASS + 1 08190317
823: WRITE (I02,80002) IVTNUM 08200317
824: GO TO 0291 08210317
825: 20280 IVFAIL = IVFAIL + 1 08220317
826: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08230317
827: 0291 CONTINUE 08240317
828: C 08250317
829: C TEST 029 THROUGH TEST 032 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 08260317
830: C OF ACTUAL ARGUMENTS TO PROCEDURES USED AS DUMMY ARGUMENTS. 08270317
831: C ACTUAL ARGUMENTS TESTED INCLUDE THE NAMES OF AN EXTERNAL FUNCTION,08280317
832: C AN INTRINSIC FUNCTION, AND A SUBROUTINE. 08290317
833: C 08300317
834: C 08310317
835: C **** FCVS PROGRAM 317 - TEST 029 **** 08320317
836: C 08330317
837: C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT. 08340317
838: C 08350317
839: IVTNUM = 29 08360317
840: IF (ICZERO) 30290, 0290, 30290 08370317
841: 0290 CONTINUE 08380317
842: IVCOMP = 0 08390317
843: IVCOMP = FF324(FF325,5) 08400317
844: IVCORR = 7 08410317
845: 40290 IF (IVCOMP - 7) 20290, 10290, 20290 08420317
846: 30290 IVDELE = IVDELE + 1 08430317
847: WRITE (I02,80000) IVTNUM 08440317
848: IF (ICZERO) 10290, 0301, 20290 08450317
849: 10290 IVPASS = IVPASS + 1 08460317
850: WRITE (I02,80002) IVTNUM 08470317
851: GO TO 0301 08480317
852: 20290 IVFAIL = IVFAIL + 1 08490317
853: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08500317
854: 0301 CONTINUE 08510317
855: C 08520317
856: C **** FCVS PROGRAM 317 - TEST 030 **** 08530317
857: C 08540317
858: C USE AN INTRINSIC FUNCTION NAME AS AN ACTUAL ARGUMENT. 08550317
859: C 08560317
860: IVTNUM = 30 08570317
861: IF (ICZERO) 30300, 0300, 30300 08580317
862: 0300 CONTINUE 08590317
863: IVCOMP = 0 08600317
864: IVCOMP = FF324(IABS,-7) 08610317
865: IVCORR = 8 08620317
866: 40300 IF (IVCOMP - 8) 20300, 10300, 20300 08630317
867: 30300 IVDELE = IVDELE + 1 08640317
868: WRITE (I02,80000) IVTNUM 08650317
869: IF (ICZERO) 10300, 0311, 20300 08660317
870: 10300 IVPASS = IVPASS + 1 08670317
871: WRITE (I02,80002) IVTNUM 08680317
872: GO TO 0311 08690317
873: 20300 IVFAIL = IVFAIL + 1 08700317
874: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08710317
875: 0311 CONTINUE 08720317
876: C 08730317
877: C **** FCVS PROGRAM 317 - TEST 031 **** 08740317
878: C 08750317
879: C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT. THE 08760317
880: C INTRINSIC FUNCTION NAME (NINT) IS USED AS THE DUMMY PROCEDURE 08770317
881: C NAME IN THE EXTERNAL FUNCTION AND THEREFORE CAN NOT BE USED AS 08780317
882: C AN INTRINSIC FUNCTION WITHIN THAT PROGRAM UNIT. HOWEVER IT CAN 08790317
883: C BE REFERENCED IN THE MAIN PROGRAM FM317 AND IN THE SUBPROGRAM 08800317
884: C FF325. 08810317
885: C 08820317
886: IVTNUM = 31 08830317
887: IF (ICZERO) 30310, 0310, 30310 08840317
888: 0310 CONTINUE 08850317
889: IVCOMP = 0 08860317
890: IVCOMP = NINT(3.7) + FF324(FF325,2) 08870317
891: IVCORR = 8 08880317
892: 40310 IF (IVCOMP - 8) 20310, 10310, 20310 08890317
893: 30310 IVDELE = IVDELE + 1 08900317
894: WRITE (I02,80000) IVTNUM 08910317
895: IF (ICZERO) 10310, 0321, 20310 08920317
896: 10310 IVPASS = IVPASS + 1 08930317
897: WRITE (I02,80002) IVTNUM 08940317
898: GO TO 0321 08950317
899: 20310 IVFAIL = IVFAIL + 1 08960317
900: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08970317
901: 0321 CONTINUE 08980317
902: C 08990317
903: C **** FCVS PROGRAM 317 - TEST 032 **** 09000317
904: C 09010317
905: C USE A SUBROUTINE NAME AS AN ACTUAL ARGUMENT. 09020317
906: C 09030317
907: IVTNUM = 32 09040317
908: IF (ICZERO) 30320, 0320, 30320 09050317
909: 0320 CONTINUE 09060317
910: RVCOMP = 0.0 09070317
911: RVON01 = 3.5 09080317
912: RVCOMP = FF326(FS327,RVON01) 09090317
913: RVCORR = 5.5 09100317
914: 40320 IF (RVCOMP - 5.4995) 20320, 10320, 40321 09110317
915: 40321 IF (RVCOMP - 5.5005) 10320, 10320, 20320 09120317
916: 30320 IVDELE = IVDELE + 1 09130317
917: WRITE (I02,80000) IVTNUM 09140317
918: IF (ICZERO) 10320, 0331, 20320 09150317
919: 10320 IVPASS = IVPASS + 1 09160317
920: WRITE (I02,80002) IVTNUM 09170317
921: GO TO 0331 09180317
922: 20320 IVFAIL = IVFAIL + 1 09190317
923: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09200317
924: 0331 CONTINUE 09210317
925: C 09220317
926: C 09230317
927: C WRITE OUT TEST SUMMARY 09240317
928: C 09250317
929: WRITE (I02,90004) 09260317
930: WRITE (I02,90014) 09270317
931: WRITE (I02,90004) 09280317
932: WRITE (I02,90000) 09290317
933: WRITE (I02,90004) 09300317
934: WRITE (I02,90020) IVFAIL 09310317
935: WRITE (I02,90022) IVPASS 09320317
936: WRITE (I02,90024) IVDELE 09330317
937: STOP 09340317
938: 90001 FORMAT (1H ,24X,5HFM317) 09350317
939: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM317) 09360317
940: C 09370317
941: C FORMATS FOR TEST DETAIL LINES 09380317
942: C 09390317
943: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 09400317
944: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 09410317
945: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 09420317
946: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 09430317
947: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 09440317
948: C 09450317
949: C FORMAT STATEMENTS FOR PAGE HEADERS 09460317
950: C 09470317
951: 90002 FORMAT (1H1) 09480317
952: 90004 FORMAT (1H ) 09490317
953: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 09500317
954: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 09510317
955: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 09520317
956: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 09530317
957: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 09540317
958: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 09550317
959: C 09560317
960: C FORMAT STATEMENTS FOR RUN SUMMARY 09570317
961: C 09580317
962: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 09590317
963: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 09600317
964: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 09610317
965: END 09620317
966: INTEGER FUNCTION FF318(IDON01) 00010318
967: C DATE***82/08/02*18.33.46
968: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
969: C AUDIT FCVS78 V2.0
970: C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020318
971: C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF INTEGER ACTUAL 00030318
972: C ARGUMENTS TO AN INTEGER VARIABLE NAME USED AS AN EXTERNAL 00040318
973: C FUNCTION DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT 00050318
974: C VALUE BY ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060318
975: FF318 = IDON01 + 1 00070318
976: RETURN 00080318
977: END 00090318
978: REAL FUNCTION FF319(RDON01) 00010319
979: C DATE***82/08/02*18.33.46
980: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
981: C AUDIT FCVS78 V2.0
982: C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020319
983: C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF REAL ACTUAL 00030319
984: C ARGUMENTS TO A REAL VARIABLE NAME USED AS AN EXTERNAL FUNCTION 00040319
985: C DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY 00050319
986: C ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060319
987: FF319 = RDON01 + 1.0 00070319
988: RETURN 00080319
989: END 00090319
990: LOGICAL FUNCTION FF320(LDON01) 00010320
991: C DATE***82/08/02*18.33.46
992: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
993: C AUDIT FCVS78 V2.0
994: C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020320
995: C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF LOGICAL ACTUAL 00030320
996: C ARGUMENTS TO A LOGICAL VARIABLE NAME USED AS AN EXTERNAL 00040320
997: C FUNCTION DUMMY ARGUMENT. THIS ROUTINE NEGATES THE ARGUMENT 00050320
998: C VALUE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060320
999: LOGICAL LDON01 00070320
1000: FF320 = .NOT. LDON01 00080320
1001: RETURN 00090320
1002: END 00100320
1003: INTEGER FUNCTION FF321(IDON02) 00010321
1004: C DATE***82/08/02*18.33.46
1005: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1006: C AUDIT FCVS78 V2.0
1007: C THIS FUNCTION IS USED IN TEST 019 OF MAIN PROGRAM FM317 AS 00020321
1008: C THE TEST OF THE USE OF AN EXTERNAL FUNCTION REFERENCE AS AN 00030321
1009: C ACTUAL ARGUMENT TO A VARIABLE NAME USED AS AN EXTERNAL FUNCTION 00040321
1010: C DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY 00050321
1011: C ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060321
1012: FF321 = IDON02 + 1 00070321
1013: RETURN 00080321
1014: END 00090321
1015: INTEGER FUNCTION FF322(IDDN11) 00010322
1016: C DATE***82/08/02*18.33.46
1017: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1018: C AUDIT FCVS78 V2.0
1019: C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020322
1020: C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF ARRAY NAMES USED AS 00030322
1021: C ACTUAL ARGUMENTS TO AN ARRAY NAME USED AS AN EXTERNAL FUNCTION 00040322
1022: C DUMMY ARGUMENT. THIS ROUTINE ADDS TOGETHER THE FOUR ELEMENTS IN 00050322
1023: C THE DUMMY ARRAY AND RETURNS THE SUM AS THE FUNCTION VALUE. 00060322
1024: DIMENSION IDDN11(4) 00070322
1025: FF322 = IDDN11(1) + IDDN11(2) + IDDN11(3) + IDDN11(4) 00080322
1026: RETURN 00090322
1027: END 00100322
1028: REAL FUNCTION FF323(RDTN21) 00010323
1029: C DATE***82/08/02*18.33.46
1030: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1031: C AUDIT FCVS78 V2.0
1032: C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020323
1033: C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF ARRAY ELEMENT NAMES 00030323
1034: C USED AS ACTUAL ARGUMENTS TO AN ARRAY NAME USED AS AN EXTERNAL 00040323
1035: C FUNCTION DUMMY ARGUMENT. THIS ROUTINE ADDS TOGETHER THE FOUR 00050323
1036: C ELEMENTS IN THE DUMMY ARRAY AND RETURNS THE SUM AS THE FUNCTION 00060323
1037: C VALUE. 00070323
1038: REAL RDTN21(2,2) 00080323
1039: FF323 = RDTN21(1,1) + RDTN21(2,1) + RDTN21(1,2) + RDTN21(2,2) 00090323
1040: RETURN 00100323
1041: END 00110323
1042: INTEGER FUNCTION FF324(NINT, IDON03) 00010324
1043: C DATE***82/08/02*18.33.46
1044: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1045: C AUDIT FCVS78 V2.0
1046: C THIS FUNCTION IS USED BY TESTS 029, 030 AND 031 OF MAIN 00020324
1047: C PROGRAM FM317 TO TEST THE ASSOCIATION OF EXTERNAL FUNCTION AND 00030324
1048: C INTRINSIC FUNCTION NAMES USED AS ACTUAL ARGUMENTS TO A PROCEDURE 00040324
1049: C NAME USED AS A DUMMY ARGUMENT. THIS FUNCTION REFERENCES THE 00050324
1050: C EXTERNAL FUNCTION OR INTRINSIC FUNCTION PASSED AS A PROCEDURE 00060324
1051: C NAME ARGUMENT, INCREMENTING THE RESULT BY ONE BEFORE RETURNING 00070324
1052: C THE RESULT AS THE FUNCTION VALUE. 00080324
1053: FF324 = NINT(IDON03) + 1 00090324
1054: C **** THE NAME NINT IS A DUMMY ARGUMENT 00100324
1055: C AND NOT AN INTRINSIC FUNCTION REFERENCE ***** 00110324
1056: RETURN 00120324
1057: END 00130324
1058: INTEGER FUNCTION FF325(IDON05) 00010325
1059: C DATE***82/08/02*18.33.46
1060: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1061: C AUDIT FCVS78 V2.0
1062: C THIS FUNCTION IS USED BY TESTS 029 AND 031 OF MAIN PROGRAM 00020325
1063: C FM317 TO TEST THE ASSOCIATION OF AN EXTERNAL FUNCTION NAME USED AS00030325
1064: C AN ACTUAL ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT. 00040325
1065: C FF325 IS REFERENCED FROM EXTERNAL FUNCTION FF324 VIA A DUMMY 00050325
1066: C PROCEDURE NAME REFERENCE. THIS ROUTINE ADDS THE RESULT OF AN 00060325
1067: C INTRINSIC FUNCTION REFERENCE (NINT) TO THE ARGUMENT VALUE AND 00070325
1068: C RETURNS THE SUM AS THE FUNCTION VALUE. 00080325
1069: FF325 = IDON05 + NINT(1.2) 00090325
1070: RETURN 00100325
1071: END 00110325
1072: REAL FUNCTION FF326(RDON02,RDON03) 00010326
1073: C DATE***82/08/02*18.33.46
1074: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1075: C AUDIT FCVS78 V2.0
1076: C THIS FUNCTION IS USED BY TEST 032 OF MAIN PROGRAM FM317 TO 00020326
1077: C TEST THE ASSOCIATION OF A SUBROUTINE NAME USED AS AN ACTUAL 00030326
1078: C ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT. THIS 00040326
1079: C FUNCTION CALLS THE SUBROUTINE (FS327) PASSED AS A PROCEDURE NAME 00050326
1080: C ARGUMENT. THE VALUE OF THE ARGUMENT RETURNED FROM THIS 00060326
1081: C REFERENCE IS THEN INCREMENTED BY ONE BEFORE RETURNING THE SUM AS 00070326
1082: C THE FUNCTION VALUE. 00080326
1083: CALL RDON02(RDON03) 00090326
1084: FF326 = RDON03 + 1.0 00100326
1085: RETURN 00110326
1086: END 00120326
1087: SUBROUTINE FS327(RDON04) 00010327
1088: C DATE***82/08/02*18.33.46
1089: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1090: C AUDIT FCVS78 V2.0
1091: C THIS SUBROUTINE IS USED BY TEST 032 OF MAIN PROGRAM FM317 TO 00020327
1092: C TEST THE ASSOCIATION OF A SUBROUTINE NAME USED AS AN ACTUAL 00030327
1093: C ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT. FS327 IS 00040327
1094: C CALLED FROM EXTERNAL PROGRAM FF326 VIA A DUMMY PROCEDURE NAME 00050327
1095: C REFERENCE. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY ONE. 00060327
1096: RDON04 = RDON04 + 1.0 00070327
1097: RETURN 00080327
1098: END 00090327
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.