![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM311.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 FM311.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 FM311 00010311
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 00020311
6: C 00030311
7: C THIS ROUTINE TESTS THE USE OF THE FORTRAN IN-LINE STATEMENT 00040311
8: C FUNCTION OF TYPES INTEGER, REAL AND LOGICAL. SPECIFIC FEATURES 00050311
9: C TESTED INCLUDE, 00060311
10: C 00070311
11: C A) REAL STATEMENT FUNCTIONS USING REAL CONSTANTS AND VARIABLES 00080311
12: C IN THE EXPRESSION AND AS ACTUAL ARGUMENTS. 00090311
13: C 00100311
14: C B) STATEMENT FUNCTIONS WHICH REQUIRE CONVERSION OF THE 00110311
15: C EXPRESSION TO REAL AND INTEGER TYPING. 00120311
16: C 00130311
17: C C) THE USE OF VARIABLES, ARRAY ELEMENTS, EXTERNAL REFERENCES, 00140311
18: C AND INITIALLY DEFINED ENITIIES IN THE EXPRESSION. 00150311
19: C 00160311
20: C D) VARIOUS DEFINITIONS AND USES OF DUMMY ARGUMENTS. 00170311
21: C 00180311
22: C E) ACTUAL ARGUMENTS CONSISTING OF EXPRESSIONS, INTRINSIC 00190311
23: C FUNCTION REFERENCES, AND EXTERNAL FUNCTION REFERENCES. 00200311
24: C 00210311
25: C F) CONFIRMING AND OVERRIDING THE TYPING OF STATEMENT FUNCTIONS 00220311
26: C AND DUMMY ARGUMENTS. 00230311
27: C 00240311
28: C G) USE OF STATEMENT FUNCTIONS AND DUMMY ARGUMENTS IN THE MAIN 00250311
29: C PROGRAM AND IN EXTERNAL FUNCTION AND SUBROUTINE SUBPROGRAMS.00260311
30: C 00270311
31: C THE SUBSET LEVEL FEATURES OF STATEMENT FUNCTIONS ARE ALSO TESTED 00280311
32: C IN ROUTINE FM020. 00290311
33: C 00300311
34: C REFERENCES. 00310311
35: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00320311
36: C X3.9-1978 00330311
37: C 00340311
38: C SECTION 8.3, COMMON STATEMENT 00350311
39: C SECTION 8.4, TYPE-STATEMENT 00360311
40: C SECTION 8.5, IMPLICIT STATEMENT 00370311
41: C SECTION 8.7, EXTERNAL STATEMENT 00380311
42: C SECTION 8.8, INTRINSIC STATEMENT 00390311
43: C SECTION 9, DATA STATEMENT 00400311
44: C SECTION 15.3, INTRINSIC FUNCTIONS 00410311
45: C SECTION 15.4, STATEMENT FUNCTION 00420311
46: C SECTION 15.5, EXTERNAL FUNCTIONS 00430311
47: C SECTION 15.6, SUBROUTINES 00440311
48: C SECTION 15.9.1, DUMMY ARGUMENTS 00450311
49: C SECTION 15.9.2, ACTUAL ARGUMENTS 00460311
50: C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS 00470311
51: C 00480311
52: C 00490311
53: C ******************************************************************00500311
54: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00510311
55: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00520311
56: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00530311
57: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00540311
58: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00550311
59: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00560311
60: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00570311
61: C THE RESULT OF EXECUTING THESE TESTS. 00580311
62: C 00590311
63: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00600311
64: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00610311
65: C 00620311
66: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00630311
67: C DEPARTMENT OF THE NAVY 00640311
68: C FEDERAL COBOL COMPILER TESTING SERVICE 00650311
69: C WASHINGTON, D.C. 20376 00660311
70: C 00670311
71: C ******************************************************************00680311
72: C 00690311
73: C 00700311
74: IMPLICIT LOGICAL (L) 00710311
75: IMPLICIT CHARACTER*14 (C) 00720311
76: C 00730311
77: IMPLICIT INTEGER (A) 00740311
78: IMPLICIT INTEGER (B) 00750311
79: IMPLICIT REAL (K) 00760311
80: IMPLICIT REAL (M) 00770311
81: REAL NDON01 00780311
82: INTEGER EDON01 00790311
83: INTEGER FF312, FF314 00800311
84: EXTERNAL FF312 00810311
85: INTRINSIC NINT 00820311
86: DIMENSION RADN11(4), RADN12(4), RADN13(4) 00830311
87: DIMENSION IADN11(4), IADN12(4) 00840311
88: DIMENSION LADN11(4) 00850311
89: COMMON /IFOS19/IVCN01 00860311
90: DATA IVOND1/6/ 00870311
91: C TEST 001 00880311
92: RFOS01(RDON01) = 3.5 00890311
93: C TEST 002 00900311
94: RFOS02(RDON02) = RDON02 00910311
95: C TEST 003 00920311
96: RFOS03(RDON03) = RDON03 + 1.0 00930311
97: C TEST 004 00940311
98: IFOS01(RDON04) = RDON04 + 1.0 00950311
99: C TEST 005 00960311
100: RFOS04(IDON01) = IDON01 + 1 00970311
101: C TEST 006 00980311
102: IFOS02(IDON02) = IDON02 + 1.95 00990311
103: C TEST 007 01000311
104: IFOS03(IDON03) = IDON03 + IVON01 01010311
105: C TEST 008 01020311
106: RFOS05(RDON05) = RDON05 + RVON02 01030311
107: C TEST 009 01040311
108: LFOS01(LDON01) = LDON01 .OR. LVON01 01050311
109: C TEST 010 01060311
110: IFOS04(IDON04) = IDON04 + IADN11(1) 01070311
111: C TEST 011 01080311
112: RFOS06(RDON06) = RDON06 + RADN12(3) 01090311
113: C TEST 012 01100311
114: LFOS02(LDON02) = .NOT. LDON02 .AND. LADN11(2) 01110311
115: C TEST 013 01120311
116: RFOS07(IDON05) = RADN13(IDON05) 01130311
117: C TEST 014 01140311
118: IFOS05(IDON06) = IDON06 + FF312(4) 01150311
119: C TEST 015 01160311
120: IFOS06(IDON07) = (IDON07 + 1) 01170311
121: C TEST 016 01180311
122: IFOS07(IDON08) = IDON08 + IVOND1 01190311
123: C TEST 017 01200311
124: IFOS08(IDON09) = IDON09 + 1 01210311
125: IFOS09(IDON10) = IFOS08(IDON10) + 1 01220311
126: C TEST 018 01230311
127: IFOS10() = IVON02 01240311
128: C TEST 019 01250311
129: IFOS11(IDON11,IDON12,IDON13) = IDON11 + IDON12 + IDON13 01260311
130: C TEST 020 01270311
131: IFOS12(IDON14) = IDON14 + 1 01280311
132: IFOS13(IDON14) = IDON14 + 2 01290311
133: C TEST 021,022,023 01300311
134: IFOS14(IDON15) = IDON15 + 1 01310311
135: C TEST 024 01320311
136: KFOS01(IDON16) = IDON16 + 1.0 01330311
137: C TEST 025 01340311
138: AFOS01(RDON07) = RDON07 + 1.0 01350311
139: C TEST 026 01360311
140: RFOS08(MDON01) = MDON01 / 5 01370311
141: C TEST 027 01380311
142: RFOS09(BDON01) = BDON01 / 5 01390311
143: C TEST 028 01400311
144: RFOS10(NDON01) = NDON01 / 5 01410311
145: C TEST 029 01420311
146: RFOS11(EDON01) = EDON01 / 5 01430311
147: C TEST 030 01440311
148: IFOS15(IVON04) = IVON04 + 1 01450311
149: C TEST 031 01460311
150: IFOS16(IDON17) = IDON17 + 1 01470311
151: C TEST 032 01480311
152: IFOS17(IDON18) = IDON18 + 1 01490311
153: C TEST 037 01500311
154: IFOS19(IDON21) = IDON21 + 1 01510311
155: C 01520311
156: C 01530311
157: C 01540311
158: C INITIALIZATION SECTION. 01550311
159: C 01560311
160: C INITIALIZE CONSTANTS 01570311
161: C ******************** 01580311
162: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01590311
163: I01 = 5 01600311
164: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01610311
165: I02 = 6 01620311
166: C SYSTEM ENVIRONMENT SECTION 01630311
167: C 01640311
168: I01 = 5 01650311
169: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01660311
170: C (UNIT NUMBER FOR CARD READER). 01670311
171: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01680311
172: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01690311
173: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01700311
174: C 01710311
175: I02 = 6 01720311
176: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01730311
177: C (UNIT NUMBER FOR PRINTER). 01740311
178: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01750311
179: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01760311
180: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01770311
181: C 01780311
182: IVPASS = 0 01790311
183: IVFAIL = 0 01800311
184: IVDELE = 0 01810311
185: ICZERO = 0 01820311
186: C 01830311
187: C WRITE OUT PAGE HEADERS 01840311
188: C 01850311
189: WRITE (I02,90002) 01860311
190: WRITE (I02,90006) 01870311
191: WRITE (I02,90008) 01880311
192: WRITE (I02,90004) 01890311
193: WRITE (I02,90010) 01900311
194: WRITE (I02,90004) 01910311
195: WRITE (I02,90016) 01920311
196: WRITE (I02,90001) 01930311
197: WRITE (I02,90004) 01940311
198: WRITE (I02,90012) 01950311
199: WRITE (I02,90014) 01960311
200: WRITE (I02,90004) 01970311
201: C 01980311
202: C 01990311
203: C TEST 001 THROUGH TEST 003 TEST REAL STATEMENT FUNCTIONS WHERE THE 02000311
204: C EXPRESSION CONSISTS OF REAL CONSTANTS AND VARIABLES AND THE ACTUAL02010311
205: C ARGUMENTS ARE EITHER REAL CONSTANTS OR VARIABLES. 02020311
206: C 02030311
207: C 02040311
208: C **** FCVS PROGRAM 311 - TEST 001 **** 02050311
209: C 02060311
210: C EXPRESSION CONSISTS OF REAL CONSTANT (NO DUMMY ARGUMENT). 02070311
211: C 02080311
212: IVTNUM = 1 02090311
213: IF (ICZERO) 30010, 0010, 30010 02100311
214: 0010 CONTINUE 02110311
215: RVCOMP = 0.0 02120311
216: RVCOMP = RFOS01(1.0) 02130311
217: RVCORR = 3.5 02140311
218: 40010 IF (RVCOMP - 3.4995) 20010, 10010, 40011 02150311
219: 40011 IF (RVCOMP - 3.5005) 10010, 10010, 20010 02160311
220: 30010 IVDELE = IVDELE + 1 02170311
221: WRITE (I02,80000) IVTNUM 02180311
222: IF (ICZERO) 10010, 0021, 20010 02190311
223: 10010 IVPASS = IVPASS + 1 02200311
224: WRITE (I02,80002) IVTNUM 02210311
225: GO TO 0021 02220311
226: 20010 IVFAIL = IVFAIL + 1 02230311
227: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02240311
228: 0021 CONTINUE 02250311
229: C 02260311
230: C **** FCVS PROGRAM 311 - TEST 002 **** 02270311
231: C 02280311
232: C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL 02290311
233: C CONSTANT. 02300311
234: C 02310311
235: IVTNUM = 2 02320311
236: IF (ICZERO) 30020, 0020, 30020 02330311
237: 0020 CONTINUE 02340311
238: RVCOMP = 0.0 02350311
239: RVCOMP = RFOS02(1.3333) 02360311
240: RVCORR = 1.3333 02370311
241: 40020 IF (RVCOMP - 1.3328) 20020, 10020, 40021 02380311
242: 40021 IF (RVCOMP - 1.3338) 10020, 10020, 20020 02390311
243: 30020 IVDELE = IVDELE + 1 02400311
244: WRITE (I02,80000) IVTNUM 02410311
245: IF (ICZERO) 10020, 0031, 20020 02420311
246: 10020 IVPASS = IVPASS + 1 02430311
247: WRITE (I02,80002) IVTNUM 02440311
248: GO TO 0031 02450311
249: 20020 IVFAIL = IVFAIL + 1 02460311
250: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02470311
251: 0031 CONTINUE 02480311
252: C 02490311
253: C **** FCVS PROGRAM 311 - TEST 003 **** 02500311
254: C 02510311
255: C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL 02520311
256: C VARIABLE. 02530311
257: C 02540311
258: IVTNUM = 3 02550311
259: IF (ICZERO) 30030, 0030, 30030 02560311
260: 0030 CONTINUE 02570311
261: RVCOMP = 0.0 02580311
262: RVON01 = 4.5 02590311
263: RVCOMP = RFOS03(RVON01) 02600311
264: RVCORR = 5.5 02610311
265: 40030 IF (RVCOMP - 5.4995) 20030, 10030, 40031 02620311
266: 40031 IF (RVCOMP - 5.5005) 10030, 10030, 20030 02630311
267: 30030 IVDELE = IVDELE + 1 02640311
268: WRITE (I02,80000) IVTNUM 02650311
269: IF (ICZERO) 10030, 0041, 20030 02660311
270: 10030 IVPASS = IVPASS + 1 02670311
271: WRITE (I02,80002) IVTNUM 02680311
272: GO TO 0041 02690311
273: 20030 IVFAIL = IVFAIL + 1 02700311
274: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02710311
275: 0041 CONTINUE 02720311
276: C 02730311
277: C TEST 004 THROUGH TEST 006 TEST STATEMENT FUNCTIONS WHICH REQUIRE 02740311
278: C TYPE CONVERSION OF THE EXPRESSION. 02750311
279: C 02760311
280: C 02770311
281: C **** FCVS PROGRAM 311 - TEST 004 **** 02780311
282: C 02790311
283: C INTEGER STATEMENT FUNCTION WITH REAL EXPRESSION. 02800311
284: C 02810311
285: IVTNUM = 4 02820311
286: IF (ICZERO) 30040, 0040, 30040 02830311
287: 0040 CONTINUE 02840311
288: IVCOMP = 0 02850311
289: IVCOMP = IFOS01(2.3) 02860311
290: IVCORR = 3 02870311
291: 40040 IF (IVCOMP - 3) 20040, 10040, 20040 02880311
292: 30040 IVDELE = IVDELE + 1 02890311
293: WRITE (I02,80000) IVTNUM 02900311
294: IF (ICZERO) 10040, 0051, 20040 02910311
295: 10040 IVPASS = IVPASS + 1 02920311
296: WRITE (I02,80002) IVTNUM 02930311
297: GO TO 0051 02940311
298: 20040 IVFAIL = IVFAIL + 1 02950311
299: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02960311
300: 0051 CONTINUE 02970311
301: C 02980311
302: C **** FCVS PROGRAM 311 - TEST 005 **** 02990311
303: C 03000311
304: C REAL STATEMENT FUNCTION WITH INTEGER EXPRESSION 03010311
305: C 03020311
306: IVTNUM = 5 03030311
307: IF (ICZERO) 30050, 0050, 30050 03040311
308: 0050 CONTINUE 03050311
309: RVCOMP = 0.0 03060311
310: RVCOMP = RFOS04(3) 03070311
311: RVCORR = 4.0 03080311
312: 40050 IF (RVCOMP - 3.9995) 20050, 10050, 40051 03090311
313: 40051 IF (RVCOMP - 4.0005) 10050, 10050, 20050 03100311
314: 30050 IVDELE = IVDELE + 1 03110311
315: WRITE (I02,80000) IVTNUM 03120311
316: IF (ICZERO) 10050, 0061, 20050 03130311
317: 10050 IVPASS = IVPASS + 1 03140311
318: WRITE (I02,80002) IVTNUM 03150311
319: GO TO 0061 03160311
320: 20050 IVFAIL = IVFAIL + 1 03170311
321: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03180311
322: 0061 CONTINUE 03190311
323: C 03200311
324: C **** FCVS PROGRAM 311 - TEST 006 **** 03210311
325: C 03220311
326: C INTEGER STATEMENT FUNCTION WITH EXPRESSION CONSISTING OF INTEGER 03230311
327: C AND REAL PRIMARIES. 03240311
328: C 03250311
329: IVTNUM = 6 03260311
330: IF (ICZERO) 30060, 0060, 30060 03270311
331: 0060 CONTINUE 03280311
332: IVCOMP = 0 03290311
333: IVCOMP = IFOS02(2) 03300311
334: IVCORR = 3 03310311
335: 40060 IF (IVCOMP - 3) 20060, 10060, 20060 03320311
336: 30060 IVDELE = IVDELE + 1 03330311
337: WRITE (I02,80000) IVTNUM 03340311
338: IF (ICZERO) 10060, 0071, 20060 03350311
339: 10060 IVPASS = IVPASS + 1 03360311
340: WRITE (I02,80002) IVTNUM 03370311
341: GO TO 0071 03380311
342: 20060 IVFAIL = IVFAIL + 1 03390311
343: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03400311
344: 0071 CONTINUE 03410311
345: C 03420311
346: C TEST 007 THROUGH TEST 017 TEST THE USAGE OF VARIOUS PRIMARIES 03430311
347: C IN THE EXPRESSION OF A STATEMENT FUNCTION. 03440311
348: C 03450311
349: C 03460311
350: C **** FCVS PROGRAM 311 - TEST 007 **** 03470311
351: C 03480311
352: C USE INTEGER VARIABLE AS PRIMARY 03490311
353: C 03500311
354: IVTNUM = 7 03510311
355: IF (ICZERO) 30070, 0070, 30070 03520311
356: 0070 CONTINUE 03530311
357: IVCOMP = 0 03540311
358: IVON01 = 3 03550311
359: IVCOMP = IFOS03(4) 03560311
360: IVCORR = 7 03570311
361: 40070 IF (IVCOMP - 7) 20070, 10070, 20070 03580311
362: 30070 IVDELE = IVDELE + 1 03590311
363: WRITE (I02,80000) IVTNUM 03600311
364: IF (ICZERO) 10070, 0081, 20070 03610311
365: 10070 IVPASS = IVPASS + 1 03620311
366: WRITE (I02,80002) IVTNUM 03630311
367: GO TO 0081 03640311
368: 20070 IVFAIL = IVFAIL + 1 03650311
369: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03660311
370: 0081 CONTINUE 03670311
371: C 03680311
372: C **** FCVS PROGRAM 311 - TEST 008 **** 03690311
373: C 03700311
374: C USE REAL VARIABLE AS PRIMARY. 03710311
375: C 03720311
376: IVTNUM = 8 03730311
377: IF (ICZERO) 30080, 0080, 30080 03740311
378: 0080 CONTINUE 03750311
379: RVCOMP = 0.0 03760311
380: RVON02 = 1.5 03770311
381: RADN11(2) = 1.3 03780311
382: RVCOMP = RFOS05(RADN11(2)) 03790311
383: RVCORR = 2.8 03800311
384: 40080 IF (RVCOMP - 2.7995) 20080, 10080, 40081 03810311
385: 40081 IF (RVCOMP - 2.8005) 10080, 10080, 20080 03820311
386: 30080 IVDELE = IVDELE + 1 03830311
387: WRITE (I02,80000) IVTNUM 03840311
388: IF (ICZERO) 10080, 0091, 20080 03850311
389: 10080 IVPASS = IVPASS + 1 03860311
390: WRITE (I02,80002) IVTNUM 03870311
391: GO TO 0091 03880311
392: 20080 IVFAIL = IVFAIL + 1 03890311
393: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03900311
394: 0091 CONTINUE 03910311
395: C 03920311
396: C **** FCVS PROGRAM 311 - TEST 009 **** 03930311
397: C 03940311
398: C USE LOGICAL VARIABLE AS PRIMARY. 03950311
399: C 03960311
400: IVTNUM = 9 03970311
401: IF (ICZERO) 30090, 0090, 30090 03980311
402: 0090 CONTINUE 03990311
403: LVON01 = .TRUE. 04000311
404: IVCOMP = 0 04010311
405: IF (LFOS01(.FALSE.)) IVCOMP = 1 04020311
406: IVCORR = 1 04030311
407: 40090 IF (IVCOMP - 1) 20090, 10090, 20090 04040311
408: 30090 IVDELE = IVDELE + 1 04050311
409: WRITE (I02,80000) IVTNUM 04060311
410: IF (ICZERO) 10090, 0101, 20090 04070311
411: 10090 IVPASS = IVPASS + 1 04080311
412: WRITE (I02,80002) IVTNUM 04090311
413: GO TO 0101 04100311
414: 20090 IVFAIL = IVFAIL + 1 04110311
415: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04120311
416: 0101 CONTINUE 04130311
417: C 04140311
418: C **** FCVS PROGRAM 311 - TEST 010 **** 04150311
419: C 04160311
420: C USE INTEGER ARRAY ELEMENT NAME AS PRIMARY. 04170311
421: C 04180311
422: IVTNUM = 10 04190311
423: IF (ICZERO) 30100, 0100, 30100 04200311
424: 0100 CONTINUE 04210311
425: IVCOMP = 0 04220311
426: IADN11(1) = 7 04230311
427: IVCOMP = IFOS04(-4) 04240311
428: IVCORR = 3 04250311
429: 40100 IF (IVCOMP - 3) 20100, 10100, 20100 04260311
430: 30100 IVDELE = IVDELE + 1 04270311
431: WRITE (I02,80000) IVTNUM 04280311
432: IF (ICZERO) 10100, 0111, 20100 04290311
433: 10100 IVPASS = IVPASS + 1 04300311
434: WRITE (I02,80002) IVTNUM 04310311
435: GO TO 0111 04320311
436: 20100 IVFAIL = IVFAIL + 1 04330311
437: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04340311
438: 0111 CONTINUE 04350311
439: C 04360311
440: C **** FCVS PROGRAM 311 - TEST 011 **** 04370311
441: C 04380311
442: C USE REAL ARRAY ELEMENT NAME AS PRIMARY. 04390311
443: C 04400311
444: IVTNUM = 11 04410311
445: IF (ICZERO) 30110, 0110, 30110 04420311
446: 0110 CONTINUE 04430311
447: RVCOMP = 0.0 04440311
448: RADN12(3) = 1.23 04450311
449: RVCOMP = RFOS06(3.0) 04460311
450: RVCORR = 4.23 04470311
451: 40110 IF (RVCOMP - 4.2295) 20110, 10110, 40111 04480311
452: 40111 IF (RVCOMP - 4.2305) 10110, 10110, 20110 04490311
453: 30110 IVDELE = IVDELE + 1 04500311
454: WRITE (I02,80000) IVTNUM 04510311
455: IF (ICZERO) 10110, 0121, 20110 04520311
456: 10110 IVPASS = IVPASS + 1 04530311
457: WRITE (I02,80002) IVTNUM 04540311
458: GO TO 0121 04550311
459: 20110 IVFAIL = IVFAIL + 1 04560311
460: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04570311
461: 0121 CONTINUE 04580311
462: C 04590311
463: C **** FCVS PROGRAM 311 - TEST 012 **** 04600311
464: C 04610311
465: C USE LOGICAL ARRAY ELEMENT NAME AS PRIMARY. 04620311
466: C 04630311
467: IVTNUM = 12 04640311
468: IF (ICZERO) 30120, 0120, 30120 04650311
469: 0120 CONTINUE 04660311
470: LADN11(2) = .TRUE. 04670311
471: IVCOMP = 0 04680311
472: IF (LFOS02(.FALSE.)) IVCOMP = 1 04690311
473: IVCORR = 1 04700311
474: 40120 IF (IVCOMP - 1) 20120, 10120, 20120 04710311
475: 30120 IVDELE = IVDELE + 1 04720311
476: WRITE (I02,80000) IVTNUM 04730311
477: IF (ICZERO) 10120, 0131, 20120 04740311
478: 10120 IVPASS = IVPASS + 1 04750311
479: WRITE (I02,80002) IVTNUM 04760311
480: GO TO 0131 04770311
481: 20120 IVFAIL = IVFAIL + 1 04780311
482: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04790311
483: 0131 CONTINUE 04800311
484: C 04810311
485: C **** FCVS PROGRAM 311 - TEST 013 **** 04820311
486: C 04830311
487: C USE A REAL ARRAY ELEMENT NAME AS PRIMARY WHERE THE SUBSCRIPT 04840311
488: C VALUE IS THE DUMMY ARGUMENT NAME. 04850311
489: C 04860311
490: IVTNUM = 13 04870311
491: IF (ICZERO) 30130, 0130, 30130 04880311
492: 0130 CONTINUE 04890311
493: RVCOMP = 0.0 04900311
494: RADN13(4) = 13.4 04910311
495: RVCOMP = RFOS07(4) 04920311
496: RVCORR = 13.4 04930311
497: 40130 IF (RVCOMP - 13.395) 20130, 10130, 40131 04940311
498: 40131 IF (RVCOMP - 13.405) 10130, 10130, 20130 04950311
499: 30130 IVDELE = IVDELE + 1 04960311
500: WRITE (I02,80000) IVTNUM 04970311
501: IF (ICZERO) 10130, 0141, 20130 04980311
502: 10130 IVPASS = IVPASS + 1 04990311
503: WRITE (I02,80002) IVTNUM 05000311
504: GO TO 0141 05010311
505: 20130 IVFAIL = IVFAIL + 1 05020311
506: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05030311
507: 0141 CONTINUE 05040311
508: C 05050311
509: C **** FCVS PROGRAM 311 - TEST 014 **** 05060311
510: C 05070311
511: C USE EXTERNAL FUNCTION REFERENCE AS PRIMARY. 05080311
512: C 05090311
513: IVTNUM = 14 05100311
514: IF (ICZERO) 30140, 0140, 30140 05110311
515: 0140 CONTINUE 05120311
516: IVCOMP = 0 05130311
517: IVCOMP = IFOS05(6) 05140311
518: IVCORR = 11 05150311
519: 40140 IF (IVCOMP - 11) 20140, 10140, 20140 05160311
520: 30140 IVDELE = IVDELE + 1 05170311
521: WRITE (I02,80000) IVTNUM 05180311
522: IF (ICZERO) 10140, 0151, 20140 05190311
523: 10140 IVPASS = IVPASS + 1 05200311
524: WRITE (I02,80002) IVTNUM 05210311
525: GO TO 0151 05220311
526: 20140 IVFAIL = IVFAIL + 1 05230311
527: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05240311
528: 0151 CONTINUE 05250311
529: C 05260311
530: C **** FCVS PROGRAM 311 - TEST 015 **** 05270311
531: C 05280311
532: C USE EXPRESSION ENCLOSED IN PARENTHESES. 05290311
533: C 05300311
534: IVTNUM = 15 05310311
535: IF (ICZERO) 30150, 0150, 30150 05320311
536: 0150 CONTINUE 05330311
537: IVCOMP = 0 05340311
538: IVCOMP = IFOS06(4) 05350311
539: IVCORR = 5 05360311
540: 40150 IF (IVCOMP - 5) 20150, 10150, 20150 05370311
541: 30150 IVDELE = IVDELE + 1 05380311
542: WRITE (I02,80000) IVTNUM 05390311
543: IF (ICZERO) 10150, 0161, 20150 05400311
544: 10150 IVPASS = IVPASS + 1 05410311
545: WRITE (I02,80002) IVTNUM 05420311
546: GO TO 0161 05430311
547: 20150 IVFAIL = IVFAIL + 1 05440311
548: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05450311
549: 0161 CONTINUE 05460311
550: C 05470311
551: C **** FCVS PROGRAM 311 - TEST 016 **** 05480311
552: C 05490311
553: C USE VARIABLE INITIALLY DEFINED IN DATA STATEMENT AS PRIMARY. 05500311
554: C 05510311
555: IVTNUM = 16 05520311
556: IF (ICZERO) 30160, 0160, 30160 05530311
557: 0160 CONTINUE 05540311
558: IVCOMP = 0 05550311
559: IVCOMP = IFOS07(3) 05560311
560: IVCORR = 9 05570311
561: 40160 IF (IVCOMP - 9) 20160, 10160, 20160 05580311
562: 30160 IVDELE = IVDELE + 1 05590311
563: WRITE (I02,80000) IVTNUM 05600311
564: IF (ICZERO) 10160, 0171, 20160 05610311
565: 10160 IVPASS = IVPASS + 1 05620311
566: WRITE (I02,80002) IVTNUM 05630311
567: GO TO 0171 05640311
568: 20160 IVFAIL = IVFAIL + 1 05650311
569: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05660311
570: 0171 CONTINUE 05670311
571: C 05680311
572: C **** FCVS PROGRAM 311 - TEST 017 **** 05690311
573: C 05700311
574: C USE PREVIOUSLY DEFINED STATEMENT FUNCTION REFERENCE AS PRIMARY. 05710311
575: C 05720311
576: IVTNUM = 17 05730311
577: IF (ICZERO) 30170, 0170, 30170 05740311
578: 0170 CONTINUE 05750311
579: IVCOMP = 0 05760311
580: IVCOMP = IFOS09(3) 05770311
581: IVCORR = 5 05780311
582: 40170 IF (IVCOMP - 5) 20170, 10170, 20170 05790311
583: 30170 IVDELE = IVDELE + 1 05800311
584: WRITE (I02,80000) IVTNUM 05810311
585: IF (ICZERO) 10170, 0181, 20170 05820311
586: 10170 IVPASS = IVPASS + 1 05830311
587: WRITE (I02,80002) IVTNUM 05840311
588: GO TO 0181 05850311
589: 20170 IVFAIL = IVFAIL + 1 05860311
590: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05870311
591: 0181 CONTINUE 05880311
592: C 05890311
593: C TEST 018 THROUGH TEST 020 APPLY TO THE DEFINITION OF THE 05900311
594: C STATEMENT FUNCTION DUMMY ARGUMENTS. 05910311
595: C 05920311
596: C 05930311
597: C **** FCVS PROGRAM 311 - TEST 018 **** 05940311
598: C 05950311
599: C DEFINE STATEMENT FUNCTION WITH NO DUMMY ARGUMENTS. 05960311
600: C 05970311
601: IVTNUM = 18 05980311
602: IF (ICZERO) 30180, 0180, 30180 05990311
603: 0180 CONTINUE 06000311
604: IVCOMP = 0 06010311
605: IVON02 = 4 06020311
606: IVCOMP = IFOS10() 06030311
607: IVCORR = 4 06040311
608: 40180 IF (IVCOMP - 4) 20180, 10180, 20180 06050311
609: 30180 IVDELE = IVDELE + 1 06060311
610: WRITE (I02,80000) IVTNUM 06070311
611: IF (ICZERO) 10180, 0191, 20180 06080311
612: 10180 IVPASS = IVPASS + 1 06090311
613: WRITE (I02,80002) IVTNUM 06100311
614: GO TO 0191 06110311
615: 20180 IVFAIL = IVFAIL + 1 06120311
616: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06130311
617: 0191 CONTINUE 06140311
618: C 06150311
619: C **** FCVS PROGRAM 311 - TEST 019 **** 06160311
620: C 06170311
621: C DEFINE STATEMENT FUNCTION WITH THREE DUMMY ARGUMENTS. 06180311
622: C 06190311
623: IVTNUM = 19 06200311
624: IF (ICZERO) 30190, 0190, 30190 06210311
625: 0190 CONTINUE 06220311
626: IVCOMP = 0 06230311
627: IVCOMP = IFOS11(1,2,3) 06240311
628: IVCORR = 6 06250311
629: 40190 IF (IVCOMP - 6) 20190, 10190, 20190 06260311
630: 30190 IVDELE = IVDELE + 1 06270311
631: WRITE (I02,80000) IVTNUM 06280311
632: IF (ICZERO) 10190, 0201, 20190 06290311
633: 10190 IVPASS = IVPASS + 1 06300311
634: WRITE (I02,80002) IVTNUM 06310311
635: GO TO 0201 06320311
636: 20190 IVFAIL = IVFAIL + 1 06330311
637: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06340311
638: 0201 CONTINUE 06350311
639: C 06360311
640: C **** FCVS PROGRAM 311 - TEST 020 **** 06370311
641: C 06380311
642: C USE THE SAME DUMMY ARGUMENT NAME IN TWO DIFFERENT 06390311
643: C STATEMENT FUNCTIONS. 06400311
644: C 06410311
645: IVTNUM = 20 06420311
646: IF (ICZERO) 30200, 0200, 30200 06430311
647: 0200 CONTINUE 06440311
648: IVCOMP = 1 06450311
649: IF (IFOS12(3) .EQ. 4) IVCOMP = IVCOMP * 2 06460311
650: IF (IFOS13(4) .EQ. 6) IVCOMP = IVCOMP * 3 06470311
651: IVCORR = 6 06480311
652: C 6 = 2 * 3 06490311
653: 40200 IF (IVCOMP - 6) 20200, 10200, 20200 06500311
654: 30200 IVDELE = IVDELE + 1 06510311
655: WRITE (I02,80000) IVTNUM 06520311
656: IF (ICZERO) 10200, 0211, 20200 06530311
657: 10200 IVPASS = IVPASS + 1 06540311
658: WRITE (I02,80002) IVTNUM 06550311
659: GO TO 0211 06560311
660: 20200 IVFAIL = IVFAIL + 1 06570311
661: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06580311
662: 0211 CONTINUE 06590311
663: C 06600311
664: C TEST 021 THROUGH TEST 022 TEST THE USAGE OF DIFFERENT TYPES OF 06610311
665: C ACTUAL ARGUMENTS IN A STATEMENT FUNCTION REFERENCE. 06620311
666: C 06630311
667: C 06640311
668: C **** FCVS PROGRAM 311 - TEST 021 **** 06650311
669: C 06660311
670: C USE AN EXPRESSION WITH OPERATORS AS AN ACTUAL ARGUMENT. 06670311
671: C 06680311
672: IVTNUM = 21 06690311
673: IF (ICZERO) 30210, 0210, 30210 06700311
674: 0210 CONTINUE 06710311
675: IVCOMP = 0 06720311
676: IVON03 = 4 06730311
677: IVCOMP = IFOS14(IVON03 * 4 + 1) 06740311
678: IVCORR = 18 06750311
679: 40210 IF (IVCOMP - 18) 20210, 10210, 20210 06760311
680: 30210 IVDELE = IVDELE + 1 06770311
681: WRITE (I02,80000) IVTNUM 06780311
682: IF (ICZERO) 10210, 0221, 20210 06790311
683: 10210 IVPASS = IVPASS + 1 06800311
684: WRITE (I02,80002) IVTNUM 06810311
685: GO TO 0221 06820311
686: 20210 IVFAIL = IVFAIL + 1 06830311
687: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06840311
688: 0221 CONTINUE 06850311
689: C 06860311
690: C **** FCVS PROGRAM 311 - TEST 022 **** 06870311
691: C 06880311
692: C USE AN INTRINSIC FUNCTION REFERENCE AS AN ACTUAL ARGUMENT. 06890311
693: C 06900311
694: IVTNUM = 22 06910311
695: IF (ICZERO) 30220, 0220, 30220 06920311
696: 0220 CONTINUE 06930311
697: IVCOMP = 0 06940311
698: RVON01 = 1.75 06950311
699: IVCOMP = IFOS14(NINT(RVON01)) 06960311
700: IVCORR = 3 06970311
701: 40220 IF (IVCOMP - 3) 20220, 10220, 20220 06980311
702: 30220 IVDELE = IVDELE + 1 06990311
703: WRITE (I02,80000) IVTNUM 07000311
704: IF (ICZERO) 10220, 0231, 20220 07010311
705: 10220 IVPASS = IVPASS + 1 07020311
706: WRITE (I02,80002) IVTNUM 07030311
707: GO TO 0231 07040311
708: 20220 IVFAIL = IVFAIL + 1 07050311
709: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07060311
710: 0231 CONTINUE 07070311
711: C 07080311
712: C **** FCVS PROGRAM 311 - TEST 023 **** 07090311
713: C 07100311
714: C USE AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL ARGUMENT. 07110311
715: C 07120311
716: IVTNUM = 23 07130311
717: IF (ICZERO) 30230, 0230, 30230 07140311
718: 0230 CONTINUE 07150311
719: IVCOMP = 0 07160311
720: IVCOMP = IFOS14(FF312(5)) 07170311
721: IVCORR = 7 07180311
722: 40230 IF (IVCOMP - 7) 20230, 10230, 20230 07190311
723: 30230 IVDELE = IVDELE + 1 07200311
724: WRITE (I02,80000) IVTNUM 07210311
725: IF (ICZERO) 10230, 0241, 20230 07220311
726: 10230 IVPASS = IVPASS + 1 07230311
727: WRITE (I02,80002) IVTNUM 07240311
728: GO TO 0241 07250311
729: 20230 IVFAIL = IVFAIL + 1 07260311
730: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07270311
731: 0241 CONTINUE 07280311
732: C 07290311
733: C TEST 024 THROUGH TEST 029 APPLY TO THE TYPING OF STATEMENT 07300311
734: C FUNCTIONS AND THE ASSOCIATED DUMMY ARGUMENT NAMES. 07310311
735: C 07320311
736: C 07330311
737: C **** FCVS PROGRAM 311 - TEST 024 **** 07340311
738: C 07350311
739: C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION WITH 07360311
740: C THE IMPLICIT STATEMENT TYPING OF REAL. 07370311
741: C 07380311
742: IVTNUM = 24 07390311
743: IF (ICZERO) 30240, 0240, 30240 07400311
744: 0240 CONTINUE 07410311
745: RVCOMP = 10.0 07420311
746: RVCOMP = KFOS01(3) / 5 07430311
747: RVCORR = 0.8 07440311
748: 40240 IF (RVCOMP - .79995) 20240, 10240, 40241 07450311
749: 40241 IF (RVCOMP - .80005) 10240, 10240, 20240 07460311
750: 30240 IVDELE = IVDELE + 1 07470311
751: WRITE (I02,80000) IVTNUM 07480311
752: IF (ICZERO) 10240, 0251, 20240 07490311
753: 10240 IVPASS = IVPASS + 1 07500311
754: WRITE (I02,80002) IVTNUM 07510311
755: GO TO 0251 07520311
756: 20240 IVFAIL = IVFAIL + 1 07530311
757: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07540311
758: 0251 CONTINUE 07550311
759: C 07560311
760: C **** FCVS PROGRAM 311 - TEST 025 **** 07570311
761: C 07580311
762: C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION WITH 07590311
763: C THE IMPLICIT STATEMENT TYPING OF INTEGER. 07600311
764: C 07610311
765: IVTNUM = 25 07620311
766: IF (ICZERO) 30250, 0250, 30250 07630311
767: 0250 CONTINUE 07640311
768: RVCOMP = 10.0 07650311
769: RVCOMP = AFOS01(3.0) / 5 07660311
770: RVCORR = 0.0 07670311
771: 40250 IF (RVCOMP + .00005) 20250, 10250, 40251 07680311
772: 40251 IF (RVCOMP - .00005) 10250, 10250, 20250 07690311
773: 30250 IVDELE = IVDELE + 1 07700311
774: WRITE (I02,80000) IVTNUM 07710311
775: IF (ICZERO) 10250, 0261, 20250 07720311
776: 10250 IVPASS = IVPASS + 1 07730311
777: WRITE (I02,80002) IVTNUM 07740311
778: GO TO 0261 07750311
779: 20250 IVFAIL = IVFAIL + 1 07760311
780: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07770311
781: 0261 CONTINUE 07780311
782: C 07790311
783: C **** FCVS PROGRAM 311 - TEST 026 **** 07800311
784: C 07810311
785: C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION 07820311
786: C DUMMY ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF REAL. 07830311
787: C 07840311
788: IVTNUM = 26 07850311
789: IF (ICZERO) 30260, 0260, 30260 07860311
790: 0260 CONTINUE 07870311
791: RVCOMP = 10.0 07880311
792: RVCOMP = RFOS08(4.0) 07890311
793: RVCORR = 0.8 07900311
794: 40260 IF (RVCOMP - .79995) 20260, 10260, 40261 07910311
795: 40261 IF (RVCOMP - .80005) 10260, 10260, 20260 07920311
796: 30260 IVDELE = IVDELE + 1 07930311
797: WRITE (I02,80000) IVTNUM 07940311
798: IF (ICZERO) 10260, 0271, 20260 07950311
799: 10260 IVPASS = IVPASS + 1 07960311
800: WRITE (I02,80002) IVTNUM 07970311
801: GO TO 0271 07980311
802: 20260 IVFAIL = IVFAIL + 1 07990311
803: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08000311
804: 0271 CONTINUE 08010311
805: C 08020311
806: C **** FCVS PROGRAM 311 - TEST 027 **** 08030311
807: C 08040311
808: C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08050311
809: C ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF INTEGER. 08060311
810: C 08070311
811: IVTNUM = 27 08080311
812: IF (ICZERO) 30270, 0270, 30270 08090311
813: 0270 CONTINUE 08100311
814: RVCOMP = 10.0 08110311
815: RVCOMP = RFOS09(4) 08120311
816: RVCORR = 0.0 08130311
817: 40270 IF (RVCOMP + .00005) 20270, 10270, 40271 08140311
818: 40271 IF (RVCOMP - .00005) 10270, 10270, 20270 08150311
819: 30270 IVDELE = IVDELE + 1 08160311
820: WRITE (I02,80000) IVTNUM 08170311
821: IF (ICZERO) 10270, 0281, 20270 08180311
822: 10270 IVPASS = IVPASS + 1 08190311
823: WRITE (I02,80002) IVTNUM 08200311
824: GO TO 0281 08210311
825: 20270 IVFAIL = IVFAIL + 1 08220311
826: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08230311
827: 0281 CONTINUE 08240311
828: C 08250311
829: C **** FCVS PROGRAM 311 - TEST 028 **** 08260311
830: C 08270311
831: C OVERRIDE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08280311
832: C ARGUMENT WITH TYPE-STATEMENT TYPING OF REAL. 08290311
833: C 08300311
834: IVTNUM = 28 08310311
835: IF (ICZERO) 30280, 0280, 30280 08320311
836: 0280 CONTINUE 08330311
837: RVCOMP = 10.0 08340311
838: RVCOMP = RFOS10(4.0) 08350311
839: RVCORR = 0.8 08360311
840: 40280 IF (RVCOMP - .79995) 20280, 10280, 40281 08370311
841: 40281 IF (RVCOMP - .80005) 10280, 10280, 20280 08380311
842: 30280 IVDELE = IVDELE + 1 08390311
843: WRITE (I02,80000) IVTNUM 08400311
844: IF (ICZERO) 10280, 0291, 20280 08410311
845: 10280 IVPASS = IVPASS + 1 08420311
846: WRITE (I02,80002) IVTNUM 08430311
847: GO TO 0291 08440311
848: 20280 IVFAIL = IVFAIL + 1 08450311
849: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08460311
850: 0291 CONTINUE 08470311
851: C 08480311
852: C **** FCVS PROGRAM 311 - TEST 029 **** 08490311
853: C 08500311
854: C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08510311
855: C ARGUMENT WITH TYPE-STATEMENT TYPING OF INTEGER. 08520311
856: C 08530311
857: IVTNUM = 29 08540311
858: IF (ICZERO) 30290, 0290, 30290 08550311
859: 0290 CONTINUE 08560311
860: RVCOMP = 10.0 08570311
861: RVCOMP = RFOS11(4) 08580311
862: RVCORR = 0.0 08590311
863: 40290 IF (RVCOMP + .00005) 20290, 10290, 40291 08600311
864: 40291 IF (RVCOMP - .00005) 10290, 10290, 20290 08610311
865: 30290 IVDELE = IVDELE + 1 08620311
866: WRITE (I02,80000) IVTNUM 08630311
867: IF (ICZERO) 10290, 0301, 20290 08640311
868: 10290 IVPASS = IVPASS + 1 08650311
869: WRITE (I02,80002) IVTNUM 08660311
870: GO TO 0301 08670311
871: 20290 IVFAIL = IVFAIL + 1 08680311
872: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08690311
873: 0301 CONTINUE 08700311
874: C 08710311
875: C **** FCVS PROGRAM 311 - TEST 030 **** 08720311
876: C 08730311
877: C TEST 030 TESTS A STATEMENT FUNCTION WHERE THE DUMMY ARGUMENT 08740311
878: C NAME IS IDENTICAL TO A VARIABLE NAME WITHIN THE PROGRAM. 08750311
879: C 08760311
880: IVTNUM = 30 08770311
881: IF (ICZERO) 30300, 0300, 30300 08780311
882: 0300 CONTINUE 08790311
883: IVON04 = 10 08800311
884: IVCOMP = 1 08810311
885: IF (IFOS15(3) .EQ. 4) IVCOMP = IVCOMP * 2 08820311
886: IF (IVON04 .EQ. 10) IVCOMP = IVCOMP * 3 08830311
887: IVCORR = 6 08840311
888: C 6 = 2 * 3 08850311
889: 40300 IF (IVCOMP - 6) 20300, 10300, 20300 08860311
890: 30300 IVDELE = IVDELE + 1 08870311
891: WRITE (I02,80000) IVTNUM 08880311
892: IF (ICZERO) 10300, 0311, 20300 08890311
893: 10300 IVPASS = IVPASS + 1 08900311
894: WRITE (I02,80002) IVTNUM 08910311
895: GO TO 0311 08920311
896: 20300 IVFAIL = IVFAIL + 1 08930311
897: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08940311
898: 0311 CONTINUE 08950311
899: C 08960311
900: C **** FCVS PROGRAM 311 - TEST 031 **** 08970311
901: C 08980311
902: C TEST 031 TESTS THE ASSIGNMENT OF A STATEMENT FUNCTION TO AN 08990311
903: C ARRAY ELEMENT. 09000311
904: C 09010311
905: IVTNUM = 31 09020311
906: IF (ICZERO) 30310, 0310, 30310 09030311
907: 0310 CONTINUE 09040311
908: IVCOMP = 0 09050311
909: IADN12(3) = IFOS16(4) 09060311
910: IVCOMP = IADN12(3) 09070311
911: IVCORR = 5 09080311
912: 40310 IF (IVCOMP - 5) 20310, 10310, 20310 09090311
913: 30310 IVDELE = IVDELE + 1 09100311
914: WRITE (I02,80000) IVTNUM 09110311
915: IF (ICZERO) 10310, 0321, 20310 09120311
916: 10310 IVPASS = IVPASS + 1 09130311
917: WRITE (I02,80002) IVTNUM 09140311
918: GO TO 0321 09150311
919: 20310 IVFAIL = IVFAIL + 1 09160311
920: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09170311
921: 0321 CONTINUE 09180311
922: C 09190311
923: C **** FCVS PROGRAM 311 - TEST 032 **** 09200311
924: C 09210311
925: C TEST 032 TESTS THE USE OF A STATEMENT FUNCTION REFERENCE 09220311
926: C IN AN ARITHMETIC EXPRESSION. 09230311
927: C 09240311
928: IVTNUM = 32 09250311
929: IF (ICZERO) 30320, 0320, 30320 09260311
930: 0320 CONTINUE 09270311
931: IVCOMP = 0 09280311
932: IVON05 = 12 09290311
933: IVCOMP = IVON05 + IFOS17(4) * 2 - 3 09300311
934: IVCORR = 19 09310311
935: 40320 IF (IVCOMP - 19) 20320, 10320, 20320 09320311
936: 30320 IVDELE = IVDELE + 1 09330311
937: WRITE (I02,80000) IVTNUM 09340311
938: IF (ICZERO) 10320, 0331, 20320 09350311
939: 10320 IVPASS = IVPASS + 1 09360311
940: WRITE (I02,80002) IVTNUM 09370311
941: GO TO 0331 09380311
942: 20320 IVFAIL = IVFAIL + 1 09390311
943: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09400311
944: 0331 CONTINUE 09410311
945: C 09420311
946: C **** FCVS PROGRAM 311 - TEST 033 **** 09430311
947: C 09440311
948: C TEST 033 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND 09450311
949: C REFERENCE WITHIN AN EXTERNAL FUNCTION. 09460311
950: C 09470311
951: IVTNUM = 33 09480311
952: IF (ICZERO) 30330, 0330, 30330 09490311
953: 0330 CONTINUE 09500311
954: RVCOMP = 0.0 09510311
955: RVCOMP = FF313(1.3) 09520311
956: RVCORR = 5.8 09530311
957: 40330 IF (RVCOMP - 5.7995) 20330, 10330, 40331 09540311
958: 40331 IF (RVCOMP - 5.8005) 10330, 10330, 20330 09550311
959: 30330 IVDELE = IVDELE + 1 09560311
960: WRITE (I02,80000) IVTNUM 09570311
961: IF (ICZERO) 10330, 0341, 20330 09580311
962: 10330 IVPASS = IVPASS + 1 09590311
963: WRITE (I02,80002) IVTNUM 09600311
964: GO TO 0341 09610311
965: 20330 IVFAIL = IVFAIL + 1 09620311
966: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09630311
967: 0341 CONTINUE 09640311
968: C 09650311
969: C **** FCVS PROGRAM 311 - TEST 034 **** 09660311
970: C 09670311
971: C TEST 034 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND 09680311
972: C REFERENCE WITHIN A SUBROUTINE. 09690311
973: C 09700311
974: IVTNUM = 34 09710311
975: IF (ICZERO) 30340, 0340, 30340 09720311
976: 0340 CONTINUE 09730311
977: RVCOMP = 0.0 09740311
978: RVON05 = 10.0 09750311
979: CALL FS316(RVON05) 09760311
980: RVCOMP = RVON05 09770311
981: RVCORR = 5.5 09780311
982: 40340 IF (RVCOMP - 5.4995) 20340, 10340, 40341 09790311
983: 40341 IF (RVCOMP - 5.5005) 10340, 10340, 20340 09800311
984: 30340 IVDELE = IVDELE + 1 09810311
985: WRITE (I02,80000) IVTNUM 09820311
986: IF (ICZERO) 10340, 0351, 20340 09830311
987: 10340 IVPASS = IVPASS + 1 09840311
988: WRITE (I02,80002) IVTNUM 09850311
989: GO TO 0351 09860311
990: 20340 IVFAIL = IVFAIL + 1 09870311
991: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09880311
992: 0351 CONTINUE 09890311
993: C 09900311
994: C **** FCVS PROGRAM 311 - TEST 035 **** 09910311
995: C 09920311
996: C TEST 035 REFERENCES THE DUMMY ARGUMENT NAME OF AN EXTERNAL 09930311
997: C FUNCTION WITHIN THE EXPRESSION OF A STATEMENT FUNCTION DEFINED 09940311
998: C IN THAT EXTERNAL FUNCTION. 09950311
999: C 09960311
1000: IVTNUM = 35 09970311
1001: IF (ICZERO) 30350, 0350, 30350 09980311
1002: 0350 CONTINUE 09990311
1003: IVCOMP = 0 10000311
1004: IVCOMP = FF314(4) 10010311
1005: IVCORR = 7 10020311
1006: 40350 IF (IVCOMP - 7) 20350, 10350, 20350 10030311
1007: 30350 IVDELE = IVDELE + 1 10040311
1008: WRITE (I02,80000) IVTNUM 10050311
1009: IF (ICZERO) 10350, 0361, 20350 10060311
1010: 10350 IVPASS = IVPASS + 1 10070311
1011: WRITE (I02,80002) IVTNUM 10080311
1012: GO TO 0361 10090311
1013: 20350 IVFAIL = IVFAIL + 1 10100311
1014: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10110311
1015: 0361 CONTINUE 10120311
1016: C 10130311
1017: C **** FCVS PROGRAM 311 - TEST 036 **** 10140311
1018: C 10150311
1019: C TEST 036 TESTS A STATEMENT FUNCTION DEFINED WITHIN AN EXTERNAL 10160311
1020: C FUNCTION IN WHICH THE STATEMENT FUNCTION DUMMY ARGUMENT NAME IS 10170311
1021: C IDENTICAL TO THE EXTERNAL FUNCTION DUMMY ARGUMENT NAME. 10180311
1022: C 10190311
1023: IVTNUM = 36 10200311
1024: IF (ICZERO) 30360, 0360, 30360 10210311
1025: 0360 CONTINUE 10220311
1026: RVCOMP = 0.0 10230311
1027: RVCOMP = FF315(5.5) 10240311
1028: RVCORR = 16.7 10250311
1029: 40360 IF (RVCOMP - 16.695) 20360, 10360, 40361 10260311
1030: 40361 IF (RVCOMP - 16.705) 10360, 10360, 20360 10270311
1031: 30360 IVDELE = IVDELE + 1 10280311
1032: WRITE (I02,80000) IVTNUM 10290311
1033: IF (ICZERO) 10360, 0371, 20360 10300311
1034: 10360 IVPASS = IVPASS + 1 10310311
1035: WRITE (I02,80002) IVTNUM 10320311
1036: GO TO 0371 10330311
1037: 20360 IVFAIL = IVFAIL + 1 10340311
1038: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 10350311
1039: 0371 CONTINUE 10360311
1040: C 10370311
1041: C **** FCVS PROGRAM 311 - TEST 037 **** 10380311
1042: C 10390311
1043: C TEST 037 TESTS THE USAGE OF THE NAME OF A COMMON BLOCK AS THE 10400311
1044: C SYMBOLIC NAME OF A STATEMENT FUNCTION. 10410311
1045: C 10420311
1046: IVTNUM = 37 10430311
1047: IF (ICZERO) 30370, 0370, 30370 10440311
1048: 0370 CONTINUE 10450311
1049: IVCOMP = 0 10460311
1050: IVCOMP = IFOS19(4) 10470311
1051: IVCORR = 5 10480311
1052: 40370 IF (IVCOMP - 5) 20370, 10370, 20370 10490311
1053: 30370 IVDELE = IVDELE + 1 10500311
1054: WRITE (I02,80000) IVTNUM 10510311
1055: IF (ICZERO) 10370, 0381, 20370 10520311
1056: 10370 IVPASS = IVPASS + 1 10530311
1057: WRITE (I02,80002) IVTNUM 10540311
1058: GO TO 0381 10550311
1059: 20370 IVFAIL = IVFAIL + 1 10560311
1060: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10570311
1061: 0381 CONTINUE 10580311
1062: C 10590311
1063: C 10600311
1064: C WRITE OUT TEST SUMMARY 10610311
1065: C 10620311
1066: WRITE (I02,90004) 10630311
1067: WRITE (I02,90014) 10640311
1068: WRITE (I02,90004) 10650311
1069: WRITE (I02,90000) 10660311
1070: WRITE (I02,90004) 10670311
1071: WRITE (I02,90020) IVFAIL 10680311
1072: WRITE (I02,90022) IVPASS 10690311
1073: WRITE (I02,90024) IVDELE 10700311
1074: STOP 10710311
1075: 90001 FORMAT (1H ,24X,5HFM311) 10720311
1076: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM311) 10730311
1077: C 10740311
1078: C FORMATS FOR TEST DETAIL LINES 10750311
1079: C 10760311
1080: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 10770311
1081: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 10780311
1082: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 10790311
1083: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 10800311
1084: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 10810311
1085: C 10820311
1086: C FORMAT STATEMENTS FOR PAGE HEADERS 10830311
1087: C 10840311
1088: 90002 FORMAT (1H1) 10850311
1089: 90004 FORMAT (1H ) 10860311
1090: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 10870311
1091: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 10880311
1092: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 10890311
1093: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 10900311
1094: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 10910311
1095: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 10920311
1096: C 10930311
1097: C FORMAT STATEMENTS FOR RUN SUMMARY 10940311
1098: C 10950311
1099: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 10960311
1100: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 10970311
1101: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 10980311
1102: END 10990311
1103: INTEGER FUNCTION FF312(IDONX1) 00010312
1104: C DATE***82/08/02*18.33.46
1105: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1106: C AUDIT FCVS78 V2.0
1107: C THIS SUBPROGRAM IS USED BY TESTS 014 AND 023 OF THE MAIN PROGRAM 00020312
1108: C FM311 TO TEST STATEMENT FUNCTION. IN TEST 014 REFERENCE TO FF312 00030312
1109: C IS USED IN THE EXPRESSION OF A STATEMENT FUNCTION. IN TEST 023 00040312
1110: C REFERENCE TO FF312 IS USED AS AN ACTUAL ARGUMENT IN A STATEMENT 00050312
1111: C FUNCTION REFERENCE. THIS ROUTINE MERELY INCREMENTS THE VALUE OF 00060312
1112: C ACTUAL/DUMMY ARGUMENT BY ONE AND RETURN THE RESULT AS THE 00070312
1113: C FUNCTION VALUE. 00080312
1114: IDONX2 = IDONX1 + 1 00090312
1115: FF312 = IDONX2 00100312
1116: RETURN 00110312
1117: END 00120312
1118: REAL FUNCTION FF313(RDON08) 00010313
1119: C DATE***82/08/02*18.33.46
1120: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1121: C AUDIT FCVS78 V2.0
1122: C THIS SUBPROGRAM IS USED BY TEST 033 OF THE MAIN PROGRAM FM311 TO 00020313
1123: C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030313
1124: C AN EXTERNAL FUNCTION. 00040313
1125: RFOS12(RDON09) = RDON09 + 1.0 00050313
1126: RVON04 = RFOS12(3.5) 00060313
1127: FF313 = RDON08 + RVON04 00070313
1128: RETURN 00080313
1129: END 00090313
1130: INTEGER FUNCTION FF314(IDON19) 00010314
1131: C DATE***82/08/02*18.33.46
1132: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1133: C AUDIT FCVS78 V2.0
1134: C THIS SUBPROGRAM IS USED BY TEST 035 OF THE MAIN PROGRAM FM311 TO 00020314
1135: C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030314
1136: C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION DUMMY 00040314
1137: C ARGUMENT IS REFERENCED WITHIN THE EXPRESSION OF THE STATEMENT 00050314
1138: C FUNCTION. 00060314
1139: IFOS18(IDON20) = IDON19 + IDON20 00070314
1140: FF314 = IFOS18(3) 00080314
1141: RETURN 00090314
1142: END 00100314
1143: REAL FUNCTION FF315(RDON12) 00010315
1144: C DATE***82/08/02*18.33.46
1145: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1146: C AUDIT FCVS78 V2.0
1147: C THIS SUBPROGRAM IS USED BY TEST 036 OF THE MAIN PROGRAM FM311 TO 00020315
1148: C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030315
1149: C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION AND 00040315
1150: C STATEMENT FUNCTION DUMMY ARGUMENTS NAMES ARE IDENTICAL. 00050315
1151: RFOS14(RDON12) = RDON12 + 1.0 00060315
1152: RVON06 = 10.2 00070315
1153: RVON07 = RFOS14(RVON06) 00080315
1154: FF315 = RDON12 + RVON07 00090315
1155: RETURN 00100315
1156: END 00110315
1157: SUBROUTINE FS316(RDON10) 00010316
1158: C DATE***82/08/02*18.33.46
1159: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
1160: C AUDIT FCVS78 V2.0
1161: C THIS SUBPROGRAM IS USED BY TEST 034 OF THE MAIN PROGRAM FM311 TO 00020316
1162: C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030316
1163: C A SUBROUTINE. 00040316
1164: RFOS13(RDON11) = RDON11 + 1.0 00050316
1165: RDON10 = RFOS13(3.5) + 1.0 00060316
1166: RETURN 00070316
1167: END 00080316
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.