|
|
1.1 root 1: PROGRAM FM251 00010251
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 00020251
6: C 00030251
7: C 00040251
8: C THIS ROUTINE TESTS THE IMPLICIT STATEMENT FOR DECLARING 00050251
9: C VARIABLES AS TYPE LOGICAL. THE TYPE OF A VARIABLE ( LOGICAL, 00060251
10: C INTEGER, OR REAL ) IS SET BY BOTH IMPLICIT STATEMENTS AND ALSO 00070251
11: C BY EXPLICIT TYPE STATEMENTS. TESTS ARE MADE TO CHECK THAT 00080251
12: C EXPLICIT TYPE STATEMENTS OVERIDE THE TYPE SET BY AN IMPLICIT 00090251
13: C STATEMENT FOR THE VARIABLES LISTED. 00100251
14: C 00110251
15: C REFERENCES 00120251
16: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130251
17: C X3.9-1977 00140251
18: C SECTION 4.7, LOGICAL TYPE 00150251
19: C SECTION 8.4.1, LOGICAL TYPE STAEMENT 00160251
20: C SECTION 8.5, IMPLICIT STATEMENT 00170251
21: C SECTION 11.5, LOGICAL IF STATEMENT 00180251
22: C 00190251
23: C 00200251
24: C FM016 - TESTS LOGICAL TYPE STATEMENTS WITH VARIOUS FORMS OF 00210251
25: C LOGICAL CONSTANTS AND VARIABLES. 00220251
26: C 00230251
27: C 00240251
28: C 00250251
29: C 00260251
30: C ******************************************************************00270251
31: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00280251
32: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00290251
33: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00300251
34: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00310251
35: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00320251
36: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00330251
37: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00340251
38: C THE RESULT OF EXECUTING THESE TESTS. 00350251
39: C 00360251
40: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00370251
41: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00380251
42: C 00390251
43: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00400251
44: C DEPARTMENT OF THE NAVY 00410251
45: C FEDERAL COBOL COMPILER TESTING SERVICE 00420251
46: C WASHINGTON, D.C. 20376 00430251
47: C 00440251
48: C ******************************************************************00450251
49: C 00460251
50: C 00470251
51: IMPLICIT LOGICAL (L) 00480251
52: IMPLICIT CHARACTER*14 (C) 00490251
53: C 00500251
54: IMPLICIT LOGICAL (M,N) 00510251
55: IMPLICIT LOGICAL ( E-H, O, P-Q, S-T, X-Y ), INTEGER ( U-W ) 00520251
56: IMPLICIT INTEGER (A, B), REAL (I, J) 00530251
57: INTEGER IVCOMP, IVPASS, IVCORR, IVTNUM, IVDELE, IVFAIL, I01, I02 00540251
58: INTEGER ICZERO 00550251
59: INTEGER MVTN01 00560251
60: REAL NVTN01 00570251
61: LOGICAL MVTN02, NVTN02, MATN21(3,3) 00580251
62: LOGICAL AVTN01 00590251
63: LOGICAL IVTN01 00600251
64: C 00610251
65: C 00620251
66: C 00630251
67: C INITIALIZATION SECTION. 00640251
68: C 00650251
69: C INITIALIZE CONSTANTS 00660251
70: C ******************** 00670251
71: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00680251
72: I01 = 5 00690251
73: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00700251
74: I02 = 6 00710251
75: C SYSTEM ENVIRONMENT SECTION 00720251
76: C 00730251
77: I01 = 5 00740251
78: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750251
79: C (UNIT NUMBER FOR CARD READER). 00760251
80: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00770251
81: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00780251
82: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00790251
83: C 00800251
84: I02 = 6 00810251
85: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00820251
86: C (UNIT NUMBER FOR PRINTER). 00830251
87: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00840251
88: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850251
89: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00860251
90: C 00870251
91: IVPASS = 0 00880251
92: IVFAIL = 0 00890251
93: IVDELE = 0 00900251
94: ICZERO = 0 00910251
95: C 00920251
96: C WRITE OUT PAGE HEADERS 00930251
97: C 00940251
98: WRITE (I02,90002) 00950251
99: WRITE (I02,90006) 00960251
100: WRITE (I02,90008) 00970251
101: WRITE (I02,90004) 00980251
102: WRITE (I02,90010) 00990251
103: WRITE (I02,90004) 01000251
104: WRITE (I02,90016) 01010251
105: WRITE (I02,90001) 01020251
106: WRITE (I02,90004) 01030251
107: WRITE (I02,90012) 01040251
108: WRITE (I02,90014) 01050251
109: WRITE (I02,90004) 01060251
110: C 01070251
111: C 01080251
112: C **** FCVS PROGRAM 251 - TEST 001 **** 01090251
113: C 01100251
114: C TEST 001 ASSIGNS A LOGICAL VALUE OF .TRUE. TO MVIN01 WHICH WAS 01110251
115: C SPECIFIED AS TYPE LOGICAL IN AN IMPLICIT STATEMENT. 01120251
116: C IMPLICIT LOGICAL (M,N) 01130251
117: C 01140251
118: IVTNUM = 1 01150251
119: IF (ICZERO) 30010, 0010, 30010 01160251
120: 0010 CONTINUE 01170251
121: IVCOMP = 0 01180251
122: MVIN01 = .TRUE. 01190251
123: IF ( MVIN01 ) IVCOMP = 1 01200251
124: IVCORR = 1 01210251
125: 40010 IF ( IVCOMP - 1 ) 20010, 10010, 20010 01220251
126: 30010 IVDELE = IVDELE + 1 01230251
127: WRITE (I02,80000) IVTNUM 01240251
128: IF (ICZERO) 10010, 0021, 20010 01250251
129: 10010 IVPASS = IVPASS + 1 01260251
130: WRITE (I02,80002) IVTNUM 01270251
131: GO TO 0021 01280251
132: 20010 IVFAIL = IVFAIL + 1 01290251
133: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01300251
134: 0021 CONTINUE 01310251
135: C 01320251
136: C **** FCVS PROGRAM 251 - TEST 002 **** 01330251
137: C 01340251
138: C TEST 002 ASSIGNS A LOGICAL VALUE OF .FALSE. TO NVIN01 WHICH 01350251
139: C WAS SPECIFIED AS TYPE LOGICAL IN AN IMPLICIT STATEMENT. 01360251
140: C IMPLICIT LOGICAL (M,N) 01370251
141: C 01380251
142: IVTNUM = 2 01390251
143: IF (ICZERO) 30020, 0020, 30020 01400251
144: 0020 CONTINUE 01410251
145: IVCOMP = 1 01420251
146: LCON01 = .FALSE. 01430251
147: NVIN01 = LCON01 01440251
148: IF ( NVIN01 ) IVCOMP = 0 01450251
149: IVCORR = 1 01460251
150: 40020 IF ( IVCOMP - 1 ) 20020, 10020, 20020 01470251
151: 30020 IVDELE = IVDELE + 1 01480251
152: WRITE (I02,80000) IVTNUM 01490251
153: IF (ICZERO) 10020, 0031, 20020 01500251
154: 10020 IVPASS = IVPASS + 1 01510251
155: WRITE (I02,80002) IVTNUM 01520251
156: GO TO 0031 01530251
157: 20020 IVFAIL = IVFAIL + 1 01540251
158: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01550251
159: 0031 CONTINUE 01560251
160: C 01570251
161: C **** FCVS PROGRAM 251 - TEST 003 **** 01580251
162: C 01590251
163: C TEST 003 ASSIGNS AN INTEGER VALUE OF 4 TO MVTN01 WHICH 01600251
164: C WAS SPECIFIED AS TYPE INTEGER EXPLICITLY IN A TYPE STATEMENT. 01610251
165: C INTEGER MVTN01 01620251
166: C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT INTEGER TYPE 01630251
167: C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD 01640251
168: C SET THE TYPE AS LOGICAL. 01650251
169: C IMPLICIT LOGICAL (M,N) 01660251
170: C 01670251
171: IVTNUM = 3 01680251
172: IF (ICZERO) 30030, 0030, 30030 01690251
173: 0030 CONTINUE 01700251
174: RVCOMP = 10.0 01710251
175: MVTN01 = 4 01720251
176: RVCOMP = MVTN01/5 01730251
177: RVCORR = 0.0 01740251
178: 40030 IF ( RVCOMP ) 20030, 10030, 20030 01750251
179: 30030 IVDELE = IVDELE + 1 01760251
180: WRITE (I02,80000) IVTNUM 01770251
181: IF (ICZERO) 10030, 0041, 20030 01780251
182: 10030 IVPASS = IVPASS + 1 01790251
183: WRITE (I02,80002) IVTNUM 01800251
184: GO TO 0041 01810251
185: 20030 IVFAIL = IVFAIL + 1 01820251
186: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01830251
187: 0041 CONTINUE 01840251
188: C 01850251
189: C **** FCVS PROGRAM 251 - TEST 004 **** 01860251
190: C 01870251
191: C TEST 004 ASSIGNS A REAL VALUE OF 4.0 TO NVTN01 WHICH 01880251
192: C WAS SPECIFIED AS TYPE REAL EXPLICITLY IN A TYPE STATEMENT. 01890251
193: C REAL NVTN01 01900251
194: C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT REAL TYPE 01910251
195: C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD 01920251
196: C SET THE TYPE AS LOGICAL. 01930251
197: C IMPLICIT LOGICAL (M,N) 01940251
198: C 01950251
199: IVTNUM = 4 01960251
200: IF (ICZERO) 30040, 0040, 30040 01970251
201: 0040 CONTINUE 01980251
202: RVCOMP = 10.0 01990251
203: NVTN01 = 4.0 02000251
204: RVCOMP = NVTN01/5 02010251
205: RVCORR = 0.8 02020251
206: 40040 IF ( RVCOMP - 0.79995 ) 20040, 10040, 40041 02030251
207: 40041 IF ( RVCOMP - 0.80005 ) 10040, 10040, 20040 02040251
208: 30040 IVDELE = IVDELE + 1 02050251
209: WRITE (I02,80000) IVTNUM 02060251
210: IF (ICZERO) 10040, 0051, 20040 02070251
211: 10040 IVPASS = IVPASS + 1 02080251
212: WRITE (I02,80002) IVTNUM 02090251
213: GO TO 0051 02100251
214: 20040 IVFAIL = IVFAIL + 1 02110251
215: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02120251
216: 0051 CONTINUE 02130251
217: C 02140251
218: C **** FCVS PROGRAM 251 - TEST 005 **** 02150251
219: C 02160251
220: C TEST 005 ASSIGNS A LOGICAL VALUE OF .TRUE. TO MVTN02 WHICH WAS 02170251
221: C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT AFTER ALSO02180251
222: C HAVING ITS FIRST LETTER M SPECIFIED AS TYPE LOGICAL IN AN 02190251
223: C IMPLICIT STATEMENT. 02200251
224: C IMPLICIT LOGICAL (M,N) 02210251
225: C LOGICAL MVTN02 02220251
226: C 02230251
227: IVTNUM = 5 02240251
228: IF (ICZERO) 30050, 0050, 30050 02250251
229: 0050 CONTINUE 02260251
230: IVCOMP = 0 02270251
231: LCON02 = .TRUE. 02280251
232: MVTN02 = LCON02 02290251
233: IF ( MVTN02 ) IVCOMP = 1 02300251
234: IVCORR = 1 02310251
235: 40050 IF ( IVCOMP - 1 ) 20050, 10050, 20050 02320251
236: 30050 IVDELE = IVDELE + 1 02330251
237: WRITE (I02,80000) IVTNUM 02340251
238: IF (ICZERO) 10050, 0061, 20050 02350251
239: 10050 IVPASS = IVPASS + 1 02360251
240: WRITE (I02,80002) IVTNUM 02370251
241: GO TO 0061 02380251
242: 20050 IVFAIL = IVFAIL + 1 02390251
243: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02400251
244: 0061 CONTINUE 02410251
245: C 02420251
246: C **** FCVS PROGRAM 251 - TEST 006 **** 02430251
247: C 02440251
248: C TEST 006 ASSIGNS A LOGICAL VALUE OF .FALSE. TO NVTN02 WHICH WAS02450251
249: C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT AFTER ALSO02460251
250: C HAVING ITS FIRST LETTER N SPECIFIED AS TYPE LOGICAL IN AN 02470251
251: C IMPLICIT STATEMENT. 02480251
252: C IMPLICIT LOGICAL (M,N) 02490251
253: C LOGICAL NVTN02 02500251
254: C 02510251
255: IVTNUM = 6 02520251
256: IF (ICZERO) 30060, 0060, 30060 02530251
257: 0060 CONTINUE 02540251
258: IVCOMP = 1 02550251
259: NVTN02 = .FALSE. 02560251
260: IF ( NVTN02 ) IVCOMP = 0 02570251
261: IVCORR = 1 02580251
262: 40060 IF ( IVCOMP - 1 ) 20060, 10060, 20060 02590251
263: 30060 IVDELE = IVDELE + 1 02600251
264: WRITE (I02,80000) IVTNUM 02610251
265: IF (ICZERO) 10060, 0071, 20060 02620251
266: 10060 IVPASS = IVPASS + 1 02630251
267: WRITE (I02,80002) IVTNUM 02640251
268: GO TO 0071 02650251
269: 20060 IVFAIL = IVFAIL + 1 02660251
270: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02670251
271: 0071 CONTINUE 02680251
272: C 02690251
273: C **** FCVS PROGRAM 251 - TEST 007 **** 02700251
274: C 02710251
275: C TEST 007 ASSIGNS A LOGICAL VALUE OF .TRUE. TO THE ARRAY ELEMENT02720251
276: C MATN21(1,1) WHICH WAS SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT 02730251
277: C TYPE STATEMENT AFTER ALSO HAVING ITS FIRST LETTER M SPECIFIED AS 02740251
278: C TYPE LOGICAL IN AN IMPLICIT STATEMENT. 02750251
279: C IMPLICIT LOGICAL (M,N) 02760251
280: C LOGICAL MATN21(3,3) 02770251
281: C 02780251
282: IVTNUM = 7 02790251
283: IF (ICZERO) 30070, 0070, 30070 02800251
284: 0070 CONTINUE 02810251
285: IVCOMP = 0 02820251
286: MATN21(1,1) = .TRUE. 02830251
287: IF ( MATN21(1,1) ) IVCOMP = 1 02840251
288: IVCORR = 1 02850251
289: 40070 IF ( IVCOMP - 1 ) 20070, 10070, 20070 02860251
290: 30070 IVDELE = IVDELE + 1 02870251
291: WRITE (I02,80000) IVTNUM 02880251
292: IF (ICZERO) 10070, 0081, 20070 02890251
293: 10070 IVPASS = IVPASS + 1 02900251
294: WRITE (I02,80002) IVTNUM 02910251
295: GO TO 0081 02920251
296: 20070 IVFAIL = IVFAIL + 1 02930251
297: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02940251
298: 0081 CONTINUE 02950251
299: C 02960251
300: C **** FCVS PROGRAM 251 - TEST 008 **** 02970251
301: C 02980251
302: C TEST 008 ASSIGNS AN INTEGER VALUE OF 4 TO AVIN01 WHICH WAS 02990251
303: C SPECIFIED AS TYPE INTEGER IN AN IMPLICIT STATEMENT. 03000251
304: C IMPLICIT INTEGER (A,B) 03010251
305: C 03020251
306: IVTNUM = 8 03030251
307: IF (ICZERO) 30080, 0080, 30080 03040251
308: 0080 CONTINUE 03050251
309: RVCOMP = 10.0 03060251
310: AVIN01 = 4 03070251
311: RVCOMP = AVIN01/5 03080251
312: RVCORR = 0.0 03090251
313: 40080 IF ( RVCOMP ) 20080, 10080, 20080 03100251
314: 30080 IVDELE = IVDELE + 1 03110251
315: WRITE (I02,80000) IVTNUM 03120251
316: IF (ICZERO) 10080, 0091, 20080 03130251
317: 10080 IVPASS = IVPASS + 1 03140251
318: WRITE (I02,80002) IVTNUM 03150251
319: GO TO 0091 03160251
320: 20080 IVFAIL = IVFAIL + 1 03170251
321: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03180251
322: 0091 CONTINUE 03190251
323: C 03200251
324: C **** FCVS PROGRAM 251 - TEST 009 **** 03210251
325: C 03220251
326: C TEST 009 ASSIGNS A LOGICAL VALUE OF .TRUE. TO AVTN01 WHICH WAS 03230251
327: C SPECIFIED AS TYPE LOGICAL EXPLICITLY IN A TYPE STATEMENT. 03240251
328: C LOGICAL AVTN01 03250251
329: C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT LOGICAL TYPE 03260251
330: C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD 03270251
331: C SET THE TYPE AS INTEGER. 03280251
332: C IMPLICIT INTEGER (A,B) 03290251
333: C 03300251
334: IVTNUM = 9 03310251
335: IF (ICZERO) 30090, 0090, 30090 03320251
336: 0090 CONTINUE 03330251
337: IVCOMP = 0 03340251
338: AVTN01 = .TRUE. 03350251
339: IF ( AVTN01 ) IVCOMP = 1 03360251
340: IVCORR = 1 03370251
341: 40090 IF ( IVCOMP - 1 ) 20090, 10090, 20090 03380251
342: 30090 IVDELE = IVDELE + 1 03390251
343: WRITE (I02,80000) IVTNUM 03400251
344: IF (ICZERO) 10090, 0101, 20090 03410251
345: 10090 IVPASS = IVPASS + 1 03420251
346: WRITE (I02,80002) IVTNUM 03430251
347: GO TO 0101 03440251
348: 20090 IVFAIL = IVFAIL + 1 03450251
349: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03460251
350: 0101 CONTINUE 03470251
351: C 03480251
352: C **** FCVS PROGRAM 251 - TEST 010 **** 03490251
353: C 03500251
354: C TEST 010 ASSIGNS A REAL VALUE OF 4.0 TO IVIN01 WHICH WAS 03510251
355: C SPECIFIED AS REAL IMPLICITLY IN AN IMPLICIT STATEMENT. 03520251
356: C IMPLICIT REAL (I,J) 03530251
357: C 03540251
358: IVTNUM = 10 03550251
359: IF (ICZERO) 30100, 0100, 30100 03560251
360: 0100 CONTINUE 03570251
361: RVCOMP = 10.0 03580251
362: IVIN01 = 4.0 03590251
363: RVCOMP = IVIN01/5 03600251
364: RVCORR = 0.8 03610251
365: 40100 IF ( RVCOMP - 0.79995 ) 20100, 10100, 40101 03620251
366: 40101 IF ( RVCOMP - 0.80005 ) 10100, 10100, 20100 03630251
367: 30100 IVDELE = IVDELE + 1 03640251
368: WRITE (I02,80000) IVTNUM 03650251
369: IF (ICZERO) 10100, 0111, 20100 03660251
370: 10100 IVPASS = IVPASS + 1 03670251
371: WRITE (I02,80002) IVTNUM 03680251
372: GO TO 0111 03690251
373: 20100 IVFAIL = IVFAIL + 1 03700251
374: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03710251
375: 0111 CONTINUE 03720251
376: C 03730251
377: C **** FCVS PROGRAM 251 - TEST 011 **** 03740251
378: C 03750251
379: C TEST 011 ASSIGNS A LOGICAL VALUE OF .FALSE. TO IVTN01 WHICH WAS03760251
380: C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT. 03770251
381: C LOGICAL IVTN01 03780251
382: C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT TYPE STATEMENT 03790251
383: C CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD SET THE TYPE 03800251
384: C AS REAL. 03810251
385: C IMPLICIT REAL (I,J) 03820251
386: C 03830251
387: IVTNUM = 11 03840251
388: IF (ICZERO) 30110, 0110, 30110 03850251
389: 0110 CONTINUE 03860251
390: IVCOMP = 1 03870251
391: IVTN01 = .FALSE. 03880251
392: IF ( IVTN01 ) IVCOMP = 0 03890251
393: IVCORR = 1 03900251
394: 40110 IF ( IVCOMP - 1 ) 20110, 10110, 20110 03910251
395: 30110 IVDELE = IVDELE + 1 03920251
396: WRITE (I02,80000) IVTNUM 03930251
397: IF (ICZERO) 10110, 0121, 20110 03940251
398: 10110 IVPASS = IVPASS + 1 03950251
399: WRITE (I02,80002) IVTNUM 03960251
400: GO TO 0121 03970251
401: 20110 IVFAIL = IVFAIL + 1 03980251
402: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03990251
403: 0121 CONTINUE 04000251
404: C 04010251
405: C 04020251
406: C THE NEXT TWO TESTS CHECK THE RANGE OF LETTERS THAT 04030251
407: C ARE SET BY THE IMPLICIT STATEMENT AS FOLLOWS - 04040251
408: C IMPLICIT LOGICAL ( E-H, O, P-Q, S-T, X-Y ), INTEGER ( U-W ) 04050251
409: C 04060251
410: C 04070251
411: C 04080251
412: C **** FCVS PROGRAM 251 - TEST 012 **** 04090251
413: C 04100251
414: C TEST 012 ASSIGNS A LOGICAL VALUE OF .TRUE. TO A SERIES OF 04110251
415: C VARIABLES THAT BEGIN WITH THE FOLLOWING LETTERS - 04120251
416: C 04130251
417: C E F G H O P Q S T X Y 04140251
418: C 04150251
419: C VARIABLES THAT BEGIN WITH THESE LETTERS SHOULD BE IMPLICITLY TYPED04160251
420: C LOGICAL BECAUSE OF THE IMPLICIT STATEMENT USING BOTH THE RANGE AND04170251
421: C SINGLE LETTER SPECIFICATION FOR TYPE LOGICAL. THE VARIABLE XVIN0104180251
422: C IS FIRST USED IN A LOGICAL IF STATEMENT. THE TRUE BRANCH SHOULD 04190251
423: C BE TAKEN TO SET IVCOMP = 1. THEN EACH OF THE VARIABLES SET TO 04200251
424: C .TRUE. ARE USED IN A SECOND LOGICAL IF STATEMENT WHICH IS ONE 04210251
425: C LARGE LOGICAL CONJUNCTION ( VARIABLE .AND. VARIABLE .AND. ... ). 04220251
426: C THE TRUE BRANCH SHOULD BE TAKEN TO INCREMENT THE VALUE OF IVCOMP 04230251
427: C TO A FINAL VALUE OF THREE (3). 04240251
428: C 04250251
429: C 04260251
430: IVTNUM = 12 04270251
431: IF (ICZERO) 30120, 0120, 30120 04280251
432: 0120 CONTINUE 04290251
433: IVCOMP = 0 04300251
434: IVCORR = 3 04310251
435: EVIN01 = .TRUE. 04320251
436: FVIN01 = .TRUE. 04330251
437: GVIN01 = .TRUE. 04340251
438: HVIN01 = .TRUE. 04350251
439: OVIN01 = .TRUE. 04360251
440: PVIN01 = .TRUE. 04370251
441: QVIN01 = .TRUE. 04380251
442: SVIN01 = .TRUE. 04390251
443: TVIN01 = .TRUE. 04400251
444: XVIN01 = .TRUE. 04410251
445: YVIN01 = .TRUE. 04420251
446: IF ( XVIN01 ) IVCOMP = 1 04430251
447: IF ( EVIN01 .AND. FVIN01 .AND. GVIN01 .AND. HVIN01 .AND. OVIN01 04440251
448: 1.AND. PVIN01 .AND. QVIN01 .AND. SVIN01 .AND. TVIN01 .AND. XVIN01 04450251
449: 2.AND. YVIN01 ) IVCOMP = IVCOMP + 2 04460251
450: 40120 IF ( IVCOMP - 3 ) 20120, 10120, 20120 04470251
451: 30120 IVDELE = IVDELE + 1 04480251
452: WRITE (I02,80000) IVTNUM 04490251
453: IF (ICZERO) 10120, 0131, 20120 04500251
454: 10120 IVPASS = IVPASS + 1 04510251
455: WRITE (I02,80002) IVTNUM 04520251
456: GO TO 0131 04530251
457: 20120 IVFAIL = IVFAIL + 1 04540251
458: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04550251
459: 0131 CONTINUE 04560251
460: C 04570251
461: C **** FCVS PROGRAM 251 - TEST 013 **** 04580251
462: C 04590251
463: C TEST 013 ASSIGNS AN INTEGER VALUE OF 4 TO VVIN01 WHICH 04600251
464: C WAS SPECIFIED AS TYPE INTEGER IMPLICITLY USING THE RANGE OF 04610251
465: C LETTERS U-W IN THE IMPLICIT INTEGER SPECIFICATION STATEMENT. 04620251
466: C DIVISION IS USED TO DETERMINE WHETHER VVIN01 IS TYPE INTEGER. 04630251
467: C 04640251
468: C 04650251
469: IVTNUM = 13 04660251
470: IF (ICZERO) 30130, 0130, 30130 04670251
471: 0130 CONTINUE 04680251
472: RVCOMP = 10.0 04690251
473: VVIN01 = 4 04700251
474: RVCOMP = VVIN01/5 04710251
475: RVCORR = 0.0 04720251
476: 40130 IF ( RVCOMP ) 20130, 10130, 20130 04730251
477: 30130 IVDELE = IVDELE + 1 04740251
478: WRITE (I02,80000) IVTNUM 04750251
479: IF (ICZERO) 10130, 0141, 20130 04760251
480: 10130 IVPASS = IVPASS + 1 04770251
481: WRITE (I02,80002) IVTNUM 04780251
482: GO TO 0141 04790251
483: 20130 IVFAIL = IVFAIL + 1 04800251
484: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04810251
485: 0141 CONTINUE 04820251
486: C 04830251
487: C 04840251
488: C WRITE OUT TEST SUMMARY 04850251
489: C 04860251
490: WRITE (I02,90004) 04870251
491: WRITE (I02,90014) 04880251
492: WRITE (I02,90004) 04890251
493: WRITE (I02,90000) 04900251
494: WRITE (I02,90004) 04910251
495: WRITE (I02,90020) IVFAIL 04920251
496: WRITE (I02,90022) IVPASS 04930251
497: WRITE (I02,90024) IVDELE 04940251
498: STOP 04950251
499: 90001 FORMAT (1H ,24X,5HFM251) 04960251
500: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM251) 04970251
501: C 04980251
502: C FORMATS FOR TEST DETAIL LINES 04990251
503: C 05000251
504: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 05010251
505: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 05020251
506: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 05030251
507: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 05040251
508: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 05050251
509: C 05060251
510: C FORMAT STATEMENTS FOR PAGE HEADERS 05070251
511: C 05080251
512: 90002 FORMAT (1H1) 05090251
513: 90004 FORMAT (1H ) 05100251
514: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 05110251
515: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 05120251
516: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 05130251
517: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 05140251
518: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 05150251
519: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 05160251
520: C 05170251
521: C FORMAT STATEMENTS FOR RUN SUMMARY 05180251
522: C 05190251
523: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 05200251
524: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 05210251
525: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 05220251
526: END 05230251
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.