![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM413.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 FM413.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 FM413 00010413
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 00020413
6: C 00030413
7: C 00040413
8: C THIS ROUTINE TESTS FOR PROPER PROCESSING OF UNFORMATTED RECORDS00050413
9: C IN FILES CONNECTED FOR DIRECT ACCESS. FOR THE SUBSET LANGUAGE A 00060413
10: C FILE CONNECTED FOR DIRECT ACCESS MUST HAVE UNFORMATTED RECORDS 00070413
11: C THIS ROUTINE FIRST TESTS SEVERAL SYNTACTICAL VARIATIONS OF THE 00080413
12: C READ AND WRITE STATEMENTS USED IN CREATING AND ACCESSING 00090413
13: C RECORDS OF THE FILE. THE OPEN STATEMENT IS USED TO CONNECT 00100413
14: C THE FILE TO A UNIT AND ESTABLISH ITS CONNECTION FOR DIRECT 00110413
15: C ACCESS. THE FIRST SERIES OF TESTS CREATE AND ACCESS THE 00120413
16: C RECORDS OF THE FILE IN RECORD NUMBER SEQUENCE AND THE LAST 00130413
17: C SERIES OF TESTS CREATE AND ACCESS RECORDS OF THE FILE IN RANDOM 00140413
18: C ORDER. 00150413
19: C 00160413
20: C UNFORMATTED RECORDS MAY HAVE BOTH CHARACTER AND NONCHARACTER 00170413
21: C DATA AND THIS DATA IS TRANSFERRED WITHOUT EDITING BETWEEN THE 00180413
22: C CURRENT RECORD AND THE ENTITIES SPECIFIED BY THE INPUT/OUTPUT 00190413
23: C LIST. THIS ROUTINE BOTH READS AND WRITES RECORDS CONTAINING 00200413
24: C THE DATA TYPES OF INTEGER ,REAL AND LOGICAL WITH I/O LIST ITEMS 00210413
25: C REPRESENTED AS VARIABLE NAMES, ARRAY ELEMENT NAMES AND ARRAY 00220413
26: C NAMES. THIS ROUTINE DOES NOT TEST DATA OF TYPE CHARACTER. 00230413
27: C 00240413
28: C ROUTINE FM411 TESTS USE OF UNFORMATTED RECORDS 00250413
29: C WITH A FILE CONNECTED FOR SEQUENTIAL ACCESS. 00260413
30: C 00270413
31: C THIS ROUTINE TESTS 00280413
32: C 00290413
33: C (1) THE STATEMENT CONSTRUCTS 00300413
34: C 00310413
35: C A. WRITE (U,REC=RN) VARIABLE-NAME,... 00320413
36: C B. WRITE (U,REC=RN) ARRAY-ELEMENT-NAME,... 00330413
37: C C. WRITE (U,REC=RN) ARRAY-NAME,... 00340413
38: C D. WRITE (U,REC=RN) - NO OUTPUT LIST 00350413
39: C E. WRITE (U,REC=RN) IMPLIED-DO-LIST 00360413
40: C F. READ (U,REC=RN) VARIABLE-NAME,... 00370413
41: C G. READ (U,REC=RN) ARRAY-ELEMENT-NAME,... 00380413
42: C H. READ (U,REC=RN) ARRAY-NAME,... 00390413
43: C I. READ (U,REC=RN) - NO INPUT LIST 00400413
44: C J. READ (U,REC=RN) IMPLIED-DO-LIST 00410413
45: C 00420413
46: C (2) USE OF A READ STATEMENT WHERE THE NUMBER OF VALUES 00430413
47: C IN THE INPUT LIST IS LESS THAN OR EQUAL TO THE 00440413
48: C NUMBER OF VALUES IN THE RECORD. 00450413
49: C (3) USE OF THE STATEMENT 00460413
50: C OPEN (U,ACCESS='DIRECT',RECL=RL) 00470413
51: C FOR CONNECTING A FILE TO THE UNIT. 00480413
52: C 00490413
53: C (4) THAT THE RECORDS OF A DIRECT ACCESS FILE NEED NOT BE 00500413
54: C BE CREATED AND READ IN ORDER OF THEIR RECORD NUMBERS. 00510413
55: C 00520413
56: C (5) THAT THE VALUES OF THE RECORD MAY BE CHANGED WHEN 00530413
57: C THE RECORD IS REWRITTEN. 00540413
58: C REFERENCES - 00550413
59: C 00560413
60: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00570413
61: C X3.9-1977 00580413
62: C 00590413
63: C SECTION 4.1, DATA TYPES 00600413
64: C SECTION 12.1.2, UNFORMATTED RECORD 00610413
65: C SECTION 12.2.4, FILE ACCESS 00620413
66: C SECTION 12.2.4.2, DIRECT ACCESS 00630413
67: C SECTION 12.3.3, UNIT SPECIFIER AND IDENTIFIER 00640413
68: C SECTION 12.7.2, END-OF-FILE SPECIFIER 00650413
69: C SECTION 12.8, READ, WRITE AND PRINT STATEMENTS 00660413
70: C SECTION 12.8.1, CONTROL INFORMATION LIST 00670413
71: C SECTION 12.8.2, INPUT/OUTPUT LIST 00680413
72: C SECTION 12.8.2.1, INPUT LIST ITEMS 00690413
73: C SECTION 12.8.2.2, OUTPUT LIST ITEMS 00700413
74: C SECTION 12.8.2.3, IMPLIED-DO LIST 00710413
75: C SECTION 12.9.5.1, UNFORMATTED DATA TRANSFER 00720413
76: C SECTION 12.10.1, OPEN STATEMENT 00730413
77: C 00740413
78: C 00750413
79: C 00760413
80: C ******************************************************************00770413
81: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00780413
82: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00790413
83: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00800413
84: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00810413
85: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00820413
86: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00830413
87: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00840413
88: C THE RESULT OF EXECUTING THESE TESTS. 00850413
89: C 00860413
90: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00870413
91: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00880413
92: C 00890413
93: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00900413
94: C DEPARTMENT OF THE NAVY 00910413
95: C FEDERAL COBOL COMPILER TESTING SERVICE 00920413
96: C WASHINGTON, D.C. 20376 00930413
97: C 00940413
98: C ******************************************************************00950413
99: C 00960413
100: C 00970413
101: IMPLICIT LOGICAL (L) 00980413
102: IMPLICIT CHARACTER*14 (C) 00990413
103: C 01000413
104: LOGICAL LAON11, LAON21, LAON31, LCONT1, LCONF2, LVONT1, LVONF2 01010413
105: LOGICAL LAON12, LAON22, LAON32, LCONT3, LCONF4, LVONT3, LVONF4 01020413
106: LOGICAL LCONT5, LCONF6, LCONT7, LCONF8, LVONT5, LVONF6, LVONT7 01030413
107: LOGICAL LVONF8 01040413
108: DIMENSION IDUMP(80) 01050413
109: DIMENSION IAON11(8), IAON21(2,4), IAON31(2,2,2) 01060413
110: DIMENSION IAON12(8), IAON22(2,4), IAON32(2,2,2) 01070413
111: DIMENSION RAON11(8), RAON21(2,4), RAON31(2,2,2) 01080413
112: DIMENSION RAON12(8), RAON22(2,4), RAON32(2,2,2) 01090413
113: DIMENSION LAON11(8), LAON21(2,4), LAON31(2,2,2) 01100413
114: DIMENSION LAON12(8), LAON22(2,4), LAON32(2,2,2) 01110413
115: DATA IAON11 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01120413
116: DATA IAON21 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01130413
117: DATA IAON31 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01140413
118: DATA LAON11 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01150413
119: 1 .TRUE., .FALSE./ 01160413
120: DATA LAON21 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01170413
121: 1 .TRUE., .FALSE./ 01180413
122: DATA LAON31 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01190413
123: 1 .TRUE., .FALSE./ 01200413
124: DATA RAON11 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01210413
125: DATA RAON21 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01220413
126: DATA RAON31 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01230413
127: ICON21 = 11 01240413
128: ICON22 = -11 01250413
129: ICON31 = +777 01260413
130: ICON32 = -777 01270413
131: ICON33 = 512 01280413
132: ICON34 = -512 01290413
133: ICON55 = -32767 01300413
134: ICON56 = 32767 01310413
135: RCON21 = 11. 01320413
136: RCON22 = -11. 01330413
137: RCON31 = +7.77 01340413
138: RCON32 = -7.77 01350413
139: RCON33 = .512 01360413
140: RCON34 = -.512 01370413
141: RCON55 = -32767. 01380413
142: RCON56 = 32767. 01390413
143: LCONT1 = .TRUE. 01400413
144: LCONF2 = .FALSE. 01410413
145: LCONT3 = .TRUE. 01420413
146: LCONF4 = .FALSE. 01430413
147: LCONT5 = .TRUE. 01440413
148: LCONF6 = .FALSE. 01450413
149: LCONT7 = .TRUE. 01460413
150: LCONF8 = .FALSE. 01470413
151: C 01480413
152: C THE FILE USED IN THIS ROUTINE HAS THE FOLLOWING PROPERTIES 01490413
153: C 01500413
154: C FILE IDENTIFIER - I10 (X-NUMBER 10) 01510413
155: C RECORD SIZE - 80 01520413
156: C ACCESS METHOD - DIRECT 01530413
157: C RECORD TYPE - UNFORMATTED 01540413
158: C DESIGNATED DEVICE - DISK 01550413
159: C TYPE OF DATA - INTEGER, REAL AND LOGICAL 01560413
160: C RECORDS IN FILE - 214 01570413
161: C 01580413
162: C THE FIRST 6 FIELDS OF EACH RECORD IN THE FILE UNIQUELY IDENT-01590413
163: C IFIES THAT RECORD. THE REMAINING FIELDS OF THE RECORD CONTAIN 01600413
164: C DATA WHICH ARE USED IN TESTING. A DESCRIPTION OF EACH FIELD 01610413
165: C OF THE PREAMBLE FOLLOWS. 01620413
166: C 01630413
167: C VARIABLE NAME IN PROGRAM FIELD NUMBER 01640413
168: C ------------------------ ------------ 01650413
169: C 01660413
170: C IPROG (ROUTINE NAME) - 1 01670413
171: C IFILE (LOGICAL/X-NUMBER) - 2 01680413
172: C ITOTR (RECORDS IN FILE) - 3 01690413
173: C IRLGN (LENGTH OF RECORD) - 4 01700413
174: C IRECN (RECORD NUMBER) - 5 01710413
175: C IEOF (9999 IF LAST RECORD) - 6 01720413
176: C 01730413
177: C 01740413
178: C 01750413
179: C 01760413
180: C INITIALIZATION SECTION. 01770413
181: C 01780413
182: C INITIALIZE CONSTANTS 01790413
183: C ******************** 01800413
184: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01810413
185: I01 = 5 01820413
186: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01830413
187: I02 = 6 01840413
188: C SYSTEM ENVIRONMENT SECTION 01850413
189: C 01860413
190: I01 = 5 01870413
191: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01880413
192: C (UNIT NUMBER FOR CARD READER). 01890413
193: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01900413
194: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01910413
195: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01920413
196: C 01930413
197: I02 = 6 01940413
198: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01950413
199: C (UNIT NUMBER FOR PRINTER). 01960413
200: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01970413
201: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01980413
202: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01990413
203: C 02000413
204: IVPASS = 0 02010413
205: IVFAIL = 0 02020413
206: IVDELE = 0 02030413
207: ICZERO = 0 02040413
208: C 02050413
209: C WRITE OUT PAGE HEADERS 02060413
210: C 02070413
211: WRITE (I02,90002) 02080413
212: WRITE (I02,90006) 02090413
213: WRITE (I02,90008) 02100413
214: WRITE (I02,90004) 02110413
215: WRITE (I02,90010) 02120413
216: WRITE (I02,90004) 02130413
217: WRITE (I02,90016) 02140413
218: WRITE (I02,90001) 02150413
219: WRITE (I02,90004) 02160413
220: WRITE (I02,90012) 02170413
221: WRITE (I02,90014) 02180413
222: WRITE (I02,90004) 02190413
223: C 02200413
224: I10 = 9 02210413
225: C I10 CONTAINS THE LOGICAL UNIT NUMBER FOR A DIRECT ACCESS FILE 02220413
226: C WITH UNFORMATTED RECORDS 02230413
227: OPEN(UNIT=I10,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=80) 02240413
228: CX101 THE CARD IS REPLACED BY CONTENTS OF X-101 CARD 02250413
229: IPROG = 413 02260413
230: IFILE = I10 02270413
231: ITOTR = 214 02280413
232: IRLGN = 80 02290413
233: IRECN = 0 02300413
234: IEOF = 0 02310413
235: C 02320413
236: C 02330413
237: C 02340413
238: C TESTS 001 THROUGH 013 OPEN A FILE CONNECTED FOR DIRECT ACCESS 02350413
239: C AND WRITE 12 RECORDS INTO THE FILE. THESE TESTS TEST USE OF THE 02360413
240: C ALLOWABLE FORMS OF THE OPEN AND WRITE STATEMENTS ON A FILE 02370413
241: C CONNECTED FOR DIRECT ACCESS. THE WRITE STATEMENT IS USED WITH 02380413
242: C THE I/O LIST ITEM AS A VARIABLE, ARRAY ELEMENT AND AN ARRAY. 02390413
243: C THE PURPOSE OF TESTS 001 THROUGH 013 IS TO CHECK THE COMPILER'S02400413
244: C ABILITY TO HANDLE THE VARIOUS STATEMENT CONSTRUCTS OF THE OPEN 02410413
245: C AND WRITE STATEMENTS. LATER TESTS WITHIN THIS ROUTINE READ 02420413
246: C AND CHECK THE RECORDS WHICH WERE CREATED. 02430413
247: C THE VALUE IN IVCORR FOR TESTS 002 THROUGH 013 IS THE RECORD 02440413
248: C NUMBER USED TO WRITE THE RECORD. 02450413
249: C 02460413
250: C 02470413
251: C 02480413
252: C **** FCVS PROGRAM 413 - TEST 001 **** 02490413
253: C 02500413
254: C 02510413
255: C TEST 001 USES THE OPEN STATEMENT TO CONNECT A FILE FOR DIRECT 02520413
256: C ACCESS. THIS IS THE FIRST ROUTINE TO USE AN OPEN STATEMENT. 02530413
257: C 02540413
258: C 02550413
259: IVTNUM = 1 02560413
260: IF (ICZERO) 30010, 0010, 30010 02570413
261: 0010 CONTINUE 02580413
262: IVCORR = 1 02590413
263: IVCOMP = 0 02600413
264: OPEN ( I10, ACCESS = 'DIRECT', RECL = 80 ) 02610413
265: IVCOMP = 1 02620413
266: 40010 IF (IVCOMP - 1) 20010, 10010, 20010 02630413
267: 30010 IVDELE = IVDELE + 1 02640413
268: WRITE (I02,80000) IVTNUM 02650413
269: IF (ICZERO) 10010, 0021, 20010 02660413
270: 10010 IVPASS = IVPASS + 1 02670413
271: WRITE (I02,80002) IVTNUM 02680413
272: GO TO 0021 02690413
273: 20010 IVFAIL = IVFAIL + 1 02700413
274: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02710413
275: 0021 CONTINUE 02720413
276: C 02730413
277: C **** FCVS PROGRAM 413 - TEST 002 **** 02740413
278: C 02750413
279: C 02760413
280: C TEST 002 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 02770413
281: C IS A VARIABLE OF INTEGER TYPE. 02780413
282: C 02790413
283: C 02800413
284: IVTNUM = 2 02810413
285: IF (ICZERO) 30020, 0020, 30020 02820413
286: 0020 CONTINUE 02830413
287: IRECN = 01 02840413
288: IVCORR = 01 02850413
289: WRITE (I10,REC=01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 02860413
290: 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 02870413
291: IVCOMP = IRECN 02880413
292: 40020 IF (IVCOMP - 01) 20020, 10020, 20020 02890413
293: 30020 IVDELE = IVDELE + 1 02900413
294: WRITE (I02,80000) IVTNUM 02910413
295: IF (ICZERO) 10020, 0031, 20020 02920413
296: 10020 IVPASS = IVPASS + 1 02930413
297: WRITE (I02,80002) IVTNUM 02940413
298: GO TO 0031 02950413
299: 20020 IVFAIL = IVFAIL + 1 02960413
300: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02970413
301: 0031 CONTINUE 02980413
302: C 02990413
303: C **** FCVS PROGRAM 413 - TEST 003 **** 03000413
304: C 03010413
305: C 03020413
306: C TEST 003 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03030413
307: C IS A VARIABLE OF REAL TYPE. 03040413
308: C 03050413
309: C 03060413
310: IVTNUM = 3 03070413
311: IF (ICZERO) 30030, 0030, 30030 03080413
312: 0030 CONTINUE 03090413
313: IRECN = 02 03100413
314: IVCORR = 02 03110413
315: WRITE (I10,REC=02) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03120413
316: 1 RCON21, RCON22, RCON31, RCON32, RCON33, RCON34, RCON55, RCON56 03130413
317: IVCOMP = IRECN 03140413
318: 40030 IF (IVCOMP - 02) 20030, 10030, 20030 03150413
319: 30030 IVDELE = IVDELE + 1 03160413
320: WRITE (I02,80000) IVTNUM 03170413
321: IF (ICZERO) 10030, 0041, 20030 03180413
322: 10030 IVPASS = IVPASS + 1 03190413
323: WRITE (I02,80002) IVTNUM 03200413
324: GO TO 0041 03210413
325: 20030 IVFAIL = IVFAIL + 1 03220413
326: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03230413
327: 0041 CONTINUE 03240413
328: C 03250413
329: C **** FCVS PROGRAM 413 - TEST 004 **** 03260413
330: C 03270413
331: C 03280413
332: C TEST 004 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03290413
333: C IS A VARIABLE OF LOGICAL TYPE. 03300413
334: C 03310413
335: C 03320413
336: IVTNUM = 4 03330413
337: IF (ICZERO) 30040, 0040, 30040 03340413
338: 0040 CONTINUE 03350413
339: IRECN = 03 03360413
340: IVCORR = 03 03370413
341: WRITE (I10,REC=03) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03380413
342: 1 LCONT1, LCONF2, LCONT3, LCONF4, LCONT5, LCONF6, LCONT7, LCONF803390413
343: IVCOMP = IRECN 03400413
344: 40040 IF (IVCOMP - 03) 20040, 10040, 20040 03410413
345: 30040 IVDELE = IVDELE + 1 03420413
346: WRITE (I02,80000) IVTNUM 03430413
347: IF (ICZERO) 10040, 0051, 20040 03440413
348: 10040 IVPASS = IVPASS + 1 03450413
349: WRITE (I02,80002) IVTNUM 03460413
350: GO TO 0051 03470413
351: 20040 IVFAIL = IVFAIL + 1 03480413
352: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03490413
353: 0051 CONTINUE 03500413
354: C 03510413
355: C **** FCVS PROGRAM 413 - TEST 005 **** 03520413
356: C 03530413
357: C 03540413
358: C TEST 005 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03550413
359: C IS AN ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO AND THREE 03560413
360: C DIMENSION ARRAYS ARE USED. 03570413
361: C 03580413
362: C 03590413
363: IVTNUM = 5 03600413
364: IF (ICZERO) 30050, 0050, 30050 03610413
365: 0050 CONTINUE 03620413
366: IRECN = 04 03630413
367: IVCORR = 04 03640413
368: WRITE (I10,REC=04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03650413
369: 1 IAON11(1), IAON11(2), IAON21(1,2), IAON21(2,2), IAON31(1,1,2), 03660413
370: 2 IAON31(2,1,2), IAON11(7), IAON11(8) 03670413
371: IVCOMP = IRECN 03680413
372: 40050 IF (IVCOMP - 04) 20050, 10050, 20050 03690413
373: 30050 IVDELE = IVDELE + 1 03700413
374: WRITE (I02,80000) IVTNUM 03710413
375: IF (ICZERO) 10050, 0061, 20050 03720413
376: 10050 IVPASS = IVPASS + 1 03730413
377: WRITE (I02,80002) IVTNUM 03740413
378: GO TO 0061 03750413
379: 20050 IVFAIL = IVFAIL + 1 03760413
380: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03770413
381: 0061 CONTINUE 03780413
382: C 03790413
383: C **** FCVS PROGRAM 413 - TEST 006 **** 03800413
384: C 03810413
385: C 03820413
386: C TEST 006 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03830413
387: C IS AN ARRAY ELEMENT OF REAL TYPE. ONE, TWO AND THREE 03840413
388: C DIMENSION ARRAYS ARE USED. 03850413
389: C 03860413
390: C 03870413
391: IVTNUM = 6 03880413
392: IF (ICZERO) 30060, 0060, 30060 03890413
393: 0060 CONTINUE 03900413
394: IRECN = 05 03910413
395: IVCORR = 05 03920413
396: WRITE (I10,REC=05) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03930413
397: 1 RAON11(1), RAON11(2), RAON21(1,2), RAON21(2,2), RAON31(1,1,2), 03940413
398: 2 RAON31(2,1,2), RAON11(7), RAON11(8) 03950413
399: IVCOMP = IRECN 03960413
400: 40060 IF (IVCOMP - 05) 20060, 10060, 20060 03970413
401: 30060 IVDELE = IVDELE + 1 03980413
402: WRITE (I02,80000) IVTNUM 03990413
403: IF (ICZERO) 10060, 0071, 20060 04000413
404: 10060 IVPASS = IVPASS + 1 04010413
405: WRITE (I02,80002) IVTNUM 04020413
406: GO TO 0071 04030413
407: 20060 IVFAIL = IVFAIL + 1 04040413
408: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04050413
409: 0071 CONTINUE 04060413
410: C 04070413
411: C **** FCVS PROGRAM 413 - TEST 007 **** 04080413
412: C 04090413
413: C 04100413
414: C TEST 007 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04110413
415: C IS AN ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO AND THREE 04120413
416: C DIMENSION ARRAYS ARE USED. 04130413
417: C 04140413
418: C 04150413
419: IVTNUM = 7 04160413
420: IF (ICZERO) 30070, 0070, 30070 04170413
421: 0070 CONTINUE 04180413
422: IRECN = 06 04190413
423: IVCORR = 06 04200413
424: WRITE (I10,REC=06) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04210413
425: 1 LAON11(1), LAON11(2), LAON21(1,2), LAON21(2,2), LAON31(1,1,2), 04220413
426: 2 LAON31(2,1,2), LAON11(7), LAON11(8) 04230413
427: IVCOMP = IRECN 04240413
428: 40070 IF (IVCOMP - 06) 20070, 10070, 20070 04250413
429: 30070 IVDELE = IVDELE + 1 04260413
430: WRITE (I02,80000) IVTNUM 04270413
431: IF (ICZERO) 10070, 0081, 20070 04280413
432: 10070 IVPASS = IVPASS + 1 04290413
433: WRITE (I02,80002) IVTNUM 04300413
434: GO TO 0081 04310413
435: 20070 IVFAIL = IVFAIL + 1 04320413
436: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04330413
437: 0081 CONTINUE 04340413
438: C 04350413
439: C **** FCVS PROGRAM 413 - TEST 008 **** 04360413
440: C 04370413
441: C 04380413
442: C TEST 008 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04390413
443: C IS AN ARRAY OF INTEGER TYPE. 04400413
444: C 04410413
445: C 04420413
446: IVTNUM = 8 04430413
447: IF (ICZERO) 30080, 0080, 30080 04440413
448: 0080 CONTINUE 04450413
449: IRECN = 07 04460413
450: IVCORR = 07 04470413
451: WRITE (I10,REC=07) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04480413
452: 1 IAON31 04490413
453: IVCOMP = IRECN 04500413
454: 40080 IF (IVCOMP - 07) 20080, 10080, 20080 04510413
455: 30080 IVDELE = IVDELE + 1 04520413
456: WRITE (I02,80000) IVTNUM 04530413
457: IF (ICZERO) 10080, 0091, 20080 04540413
458: 10080 IVPASS = IVPASS + 1 04550413
459: WRITE (I02,80002) IVTNUM 04560413
460: GO TO 0091 04570413
461: 20080 IVFAIL = IVFAIL + 1 04580413
462: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04590413
463: 0091 CONTINUE 04600413
464: C 04610413
465: C **** FCVS PROGRAM 413 - TEST 009 **** 04620413
466: C 04630413
467: C 04640413
468: C TEST 009 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04650413
469: C IS AN ARRAY OF REAL TYPE. 04660413
470: C 04670413
471: C 04680413
472: IVTNUM = 9 04690413
473: IF (ICZERO) 30090, 0090, 30090 04700413
474: 0090 CONTINUE 04710413
475: IRECN = 08 04720413
476: IVCORR = 08 04730413
477: WRITE (I10,REC=08) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04740413
478: 1 RAON31 04750413
479: IVCOMP = IRECN 04760413
480: 40090 IF (IVCOMP - 08) 20090, 10090, 20090 04770413
481: 30090 IVDELE = IVDELE + 1 04780413
482: WRITE (I02,80000) IVTNUM 04790413
483: IF (ICZERO) 10090, 0101, 20090 04800413
484: 10090 IVPASS = IVPASS + 1 04810413
485: WRITE (I02,80002) IVTNUM 04820413
486: GO TO 0101 04830413
487: 20090 IVFAIL = IVFAIL + 1 04840413
488: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04850413
489: 0101 CONTINUE 04860413
490: C 04870413
491: C **** FCVS PROGRAM 413 - TEST 010 **** 04880413
492: C 04890413
493: C 04900413
494: C TEST 010 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04910413
495: C IS AN ARRAY OF LOGICAL TYPE. 04920413
496: C 04930413
497: C 04940413
498: IVTNUM = 10 04950413
499: IF (ICZERO) 30100, 0100, 30100 04960413
500: 0100 CONTINUE 04970413
501: IRECN = 09 04980413
502: IVCORR = 09 04990413
503: WRITE (I10,REC=09) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05000413
504: 1 LAON31 05010413
505: IVCOMP = IRECN 05020413
506: 40100 IF (IVCOMP - 09) 20100, 10100, 20100 05030413
507: 30100 IVDELE = IVDELE + 1 05040413
508: WRITE (I02,80000) IVTNUM 05050413
509: IF (ICZERO) 10100, 0111, 20100 05060413
510: 10100 IVPASS = IVPASS + 1 05070413
511: WRITE (I02,80002) IVTNUM 05080413
512: GO TO 0111 05090413
513: 20100 IVFAIL = IVFAIL + 1 05100413
514: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05110413
515: 0111 CONTINUE 05120413
516: C 05130413
517: C **** FCVS PROGRAM 413 - TEST 011 **** 05140413
518: C 05150413
519: C 05160413
520: C TEST 011 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05170413
521: C IS AN IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. 05180413
522: C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER VIS-A-VIS THE 05190413
523: C ELEMENT SEQUENCE OF ARRAY IAON31. THE SEQUENCE OF VALUES WRITTEN 05200413
524: C IN THE RECORD ARE 11, 512, 777, -32767, -11, -512, -777, 32767. 05210413
525: C 05220413
526: C 05230413
527: IVTNUM = 11 05240413
528: IF (ICZERO) 30110, 0110, 30110 05250413
529: 0110 CONTINUE 05260413
530: IRECN = 10 05270413
531: IVCORR = 10 05280413
532: WRITE (I10,REC=10) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05290413
533: 1 (((IAON31 (J,K,I), I=1,2), K=1,2), J=1,2) 05300413
534: IVCOMP = IRECN 05310413
535: 40110 IF (IVCOMP - 10) 20110, 10110, 20110 05320413
536: 30110 IVDELE = IVDELE + 1 05330413
537: WRITE (I02,80000) IVTNUM 05340413
538: IF (ICZERO) 10110, 0121, 20110 05350413
539: 10110 IVPASS = IVPASS + 1 05360413
540: WRITE (I02,80002) IVTNUM 05370413
541: GO TO 0121 05380413
542: 20110 IVFAIL = IVFAIL + 1 05390413
543: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05400413
544: 0121 CONTINUE 05410413
545: C 05420413
546: C **** FCVS PROGRAM 413 - TEST 012 **** 05430413
547: C 05440413
548: C 05450413
549: C TEST 012 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05460413
550: C IS AN IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE FIELD VALUES 05470413
551: C (IN FIELD POSITION ORDER) WRITTEN IN THE RECORD ARE 11., -11., 05480413
552: C 7.77, -7.77, .512, -.512, -32767., 32767. 05490413
553: C 05500413
554: C 05510413
555: IVTNUM = 12 05520413
556: IF (ICZERO) 30120, 0120, 30120 05530413
557: 0120 CONTINUE 05540413
558: IRECN = 11 05550413
559: IVCORR = 11 05560413
560: WRITE (I10,REC=11) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05570413
561: 1 (((RAON31 (J,K,I), J=1,2), K=1,2), I=1,2) 05580413
562: IVCOMP = IRECN 05590413
563: 40120 IF (IVCOMP - 11) 20120, 10120, 20120 05600413
564: 30120 IVDELE = IVDELE + 1 05610413
565: WRITE (I02,80000) IVTNUM 05620413
566: IF (ICZERO) 10120, 0131, 20120 05630413
567: 10120 IVPASS = IVPASS + 1 05640413
568: WRITE (I02,80002) IVTNUM 05650413
569: GO TO 0131 05660413
570: 20120 IVFAIL = IVFAIL + 1 05670413
571: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05680413
572: 0131 CONTINUE 05690413
573: C 05700413
574: C **** FCVS PROGRAM 413 - TEST 013 **** 05710413
575: C 05720413
576: C 05730413
577: C TEST 013 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05740413
578: C IS AN IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. 05750413
579: C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER VIS-A-VIS THE 05760413
580: C ELEMENT SEQUENCE OF ARRAY LAON31. THE SEQUENCE OF VALUES WRITTEN 05770413
581: C IN THE RECORD ARE .TRUE., .TRUE., .FALSE., .FALSE., .TRUE., .TRUE.05780413
582: C .FALSE, .FALSE. 05790413
583: C 05800413
584: C 05810413
585: IVTNUM = 13 05820413
586: IF (ICZERO) 30130, 0130, 30130 05830413
587: 0130 CONTINUE 05840413
588: IRECN = 12 05850413
589: IVCORR = 12 05860413
590: WRITE (I10,REC=12) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05870413
591: 1 (((LAON31 (J,K,I), K=1,2), J=1,2), I=1,2) 05880413
592: IVCOMP = IRECN 05890413
593: 40130 IF (IVCOMP - 12) 20130, 10130, 20130 05900413
594: 30130 IVDELE = IVDELE + 1 05910413
595: WRITE (I02,80000) IVTNUM 05920413
596: IF (ICZERO) 10130, 0141, 20130 05930413
597: 10130 IVPASS = IVPASS + 1 05940413
598: WRITE (I02,80002) IVTNUM 05950413
599: GO TO 0141 05960413
600: 20130 IVFAIL = IVFAIL + 1 05970413
601: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05980413
602: 0141 CONTINUE 05990413
603: C 06000413
604: C 06010413
605: C TESTS 14 AND 15 TEST THE WRITE WITHOUT OUTPUT LIST ITEMS. 06020413
606: C 06030413
607: C 06040413
608: C 06050413
609: C 06060413
610: C **** FCVS PROGRAM 413 - TEST 014 **** 06070413
611: C 06080413
612: C 06090413
613: C TEST 014 USES A WRITE STATEMENT WITHOUT ANY OUTPUT LIST ITEMS. 06100413
614: C THE OUTPUT LIST ITEMS ARE OPTIONAL AND THIS TEST USES THIS FORM 06110413
615: C TO ESTABLISH A RECORD NUMBER FOR A RECORD IN THE FILE. 06120413
616: C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO. 06130413
617: C 06140413
618: C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS 06150413
619: C 12.2.4.2 (5) AND (6), DIRECT ACCESS 06160413
620: C 12.8, READ, WRITE AND PRINT STATEMENTS 06170413
621: C 06180413
622: C 06190413
623: IVTNUM = 14 06200413
624: IF (ICZERO) 30140, 0140, 30140 06210413
625: 0140 CONTINUE 06220413
626: IRECN = 13 06230413
627: IVCORR = 13 06240413
628: WRITE (I10,REC=13) 06250413
629: IVCOMP = IRECN 06260413
630: 40140 IF (IVCOMP - 13) 20140, 10140, 20140 06270413
631: 30140 IVDELE = IVDELE + 1 06280413
632: WRITE (I02,80000) IVTNUM 06290413
633: IF (ICZERO) 10140, 0151, 20140 06300413
634: 10140 IVPASS = IVPASS + 1 06310413
635: WRITE (I02,80002) IVTNUM 06320413
636: GO TO 0151 06330413
637: 20140 IVFAIL = IVFAIL + 1 06340413
638: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06350413
639: 0151 CONTINUE 06360413
640: C 06370413
641: C **** FCVS PROGRAM 413 - TEST 015 **** 06380413
642: C 06390413
643: C 06400413
644: C TEST 015 IS SIMILAR TO TEST 014 ABOVE EXCEPT THE RN OF THE 06410413
645: C RECORD SPECIFIER (REC = RN) IS AN INTEGER VARIABLE. 06420413
646: C 06430413
647: C 06440413
648: IVTNUM = 15 06450413
649: IF (ICZERO) 30150, 0150, 30150 06460413
650: 0150 CONTINUE 06470413
651: IRECN = 14 06480413
652: IVCORR = 14 06490413
653: IREC = 14 06500413
654: WRITE (I10,REC = IREC) 06510413
655: IVCOMP = IRECN 06520413
656: 40150 IF (IVCOMP - 14) 20150, 10150, 20150 06530413
657: 30150 IVDELE = IVDELE + 1 06540413
658: WRITE (I02,80000) IVTNUM 06550413
659: IF (ICZERO) 10150, 0161, 20150 06560413
660: 10150 IVPASS = IVPASS + 1 06570413
661: WRITE (I02,80002) IVTNUM 06580413
662: GO TO 0161 06590413
663: 20150 IVFAIL = IVFAIL + 1 06600413
664: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06610413
665: 0161 CONTINUE 06620413
666: C 06630413
667: C 06640413
668: C TESTS 16 AND 17 VERIFY THAT RECORDS MAY BE CREATED IN 06650413
669: C OTHER THAN SEQUENTIAL ORDER. ALSO THAT A VARIABLE MAY BY USED 06660413
670: C AS THE OPERAND OF THE REC SPECIFIER FOR A WRITE STATEMENT. 06670413
671: C 06680413
672: C 06690413
673: C 06700413
674: C **** FCVS PROGRAM 413 - TEST 016 **** 06710413
675: C 06720413
676: C 06730413
677: C TEST 016 TESTS USE OF THE REC SPECIFIER WHERE THE OPERAND 06740413
678: C IS A VARIABLE. THIS TEST IS SIMILAR TO TEST 15 EXCEPT THE WRITE 06750413
679: C STATEMENT CONTAINS OUTPUT LIST ITEMS. ONE HUNDRED RECORDS ARE 06760413
680: C WRITTEN BY INCREMENTING THE VARIABLE BY 2 FOR EACH WRITE. TEST 06770413
681: C 032 READS THE RECORDS WRITTEN BY THIS METHOD. 06780413
682: C 06790413
683: C 06800413
684: IVTNUM = 16 06810413
685: IF (ICZERO) 30160, 0160, 30160 06820413
686: 0160 CONTINUE 06830413
687: IRECN = 13 06840413
688: IREC = 13 06850413
689: DO 4132 I = 1,100 06860413
690: IREC = IREC + 2 06870413
691: IRECN = IRECN + 2 06880413
692: WRITE (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 06890413
693: 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 06900413
694: 4132 CONTINUE 06910413
695: IVCORR = 100 06920413
696: IVCOMP = IREC - 113 06930413
697: 40160 IF (IVCOMP - 100) 20160, 10160, 20160 06940413
698: 30160 IVDELE = IVDELE + 1 06950413
699: WRITE (I02,80000) IVTNUM 06960413
700: IF (ICZERO) 10160, 0171, 20160 06970413
701: 10160 IVPASS = IVPASS + 1 06980413
702: WRITE (I02,80002) IVTNUM 06990413
703: GO TO 0171 07000413
704: 20160 IVFAIL = IVFAIL + 1 07010413
705: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07020413
706: 0171 CONTINUE 07030413
707: C 07040413
708: C **** FCVS PROGRAM 413 - TEST 017 **** 07050413
709: C 07060413
710: C 07070413
711: C TEST 17 IS SIMILAR TO TEST 16 EXCEPT THE RECORD IS 07080413
712: C WRITTEN IN REVERSE ORDER OF RECORD NUMBER. ONE HUNDERD RECORDS 07090413
713: C ARE WRITTEN AND THE VARIABLE OF THE REC SPECIFIER IS DECREMENTED 07100413
714: C BY TWO FOR EACH WRITE. 07110413
715: C 07120413
716: C 07130413
717: IVTNUM = 17 07140413
718: IF (ICZERO) 30170, 0170, 30170 07150413
719: 0170 CONTINUE 07160413
720: IRECN = 216 07170413
721: IREC = 216 07180413
722: IVCOMP = 0 07190413
723: DO 4133 I=1,100 07200413
724: IREC = IREC - 2 07210413
725: IRECN = IRECN - 2 07220413
726: WRITE (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 07230413
727: 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 07240413
728: IVCOMP = IVCOMP + 1 07250413
729: 4133 CONTINUE 07260413
730: IVCORR = 100 07270413
731: 40170 IF (IVCOMP - 100) 20170, 10170, 20170 07280413
732: 30170 IVDELE = IVDELE + 1 07290413
733: WRITE (I02,80000) IVTNUM 07300413
734: IF (ICZERO) 10170, 0181, 20170 07310413
735: 10170 IVPASS = IVPASS + 1 07320413
736: WRITE (I02,80002) IVTNUM 07330413
737: GO TO 0181 07340413
738: 20170 IVFAIL = IVFAIL + 1 07350413
739: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07360413
740: 0181 CONTINUE 07370413
741: C 07380413
742: C 07390413
743: C TESTS 018 THROUGH 030 READ AND CHECK THE RECORDS CREATED IN 07400413
744: C TESTS 002 THROUGH 014. EACH OF THE TESTS IN THIS SET IS CHECKING 07410413
745: C TWO THINGS. FIRST, THAT THE READ STATEMENT CONSTRUCT IS ACCEPTED 07420413
746: C BY THE COMPILER AND SECOND THAT THE RECORDS CREATED IN TESTS 002 07430413
747: C THROUGH 013 AND READ IN THESE TESTS CAN GIVE PREDICTIBLE VALUES. 07440413
748: C THE READ STATEMENT IS USED WITH THE I/O LIST ITEM AS A VARIABLE, 07450413
749: C AN ARRAY ELEMENT AND AN ARRAY. 07460413
750: C 07470413
751: C 07480413
752: C 07490413
753: C **** FCVS PROGRAM 413 - TEST 018 **** 07500413
754: C 07510413
755: C 07520413
756: C TEST 018 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 07530413
757: C VARIABLE OF INTEGER TYPE. 07540413
758: C 07550413
759: C 07560413
760: IVTNUM = 18 07570413
761: IF (ICZERO) 30180, 0180, 30180 07580413
762: 0180 CONTINUE 07590413
763: IVON22 = 0 07600413
764: IVON56 = 0 07610413
765: IVCORR = 30 07620413
766: IVCOMP = 1 07630413
767: READ (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 07640413
768: 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 07650413
769: IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 07660413
770: IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 3 07670413
771: IF (IVON56 .EQ. 32767) IVCOMP = IVCOMP * 5 07680413
772: 40180 IF (IVCOMP - 30) 20180, 10180, 20180 07690413
773: 30180 IVDELE = IVDELE + 1 07700413
774: WRITE (I02,80000) IVTNUM 07710413
775: IF (ICZERO) 10180, 0191, 20180 07720413
776: 10180 IVPASS = IVPASS + 1 07730413
777: WRITE (I02,80002) IVTNUM 07740413
778: GO TO 0191 07750413
779: 20180 IVFAIL = IVFAIL + 1 07760413
780: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07770413
781: 0191 CONTINUE 07780413
782: C 07790413
783: C **** FCVS PROGRAM 413 - TEST 019 **** 07800413
784: C 07810413
785: C 07820413
786: C TEST 019 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 07830413
787: C VARIABLE OF REAL TYPE. 07840413
788: C 07850413
789: C 07860413
790: IVTNUM = 19 07870413
791: IF (ICZERO) 30190, 0190, 30190 07880413
792: 0190 CONTINUE 07890413
793: RVON22 = 0.0 07900413
794: RVON31 = 0.0 07910413
795: IVCORR = 30 07920413
796: IVCOMP = 1 07930413
797: READ (I10, REC = 02) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 07940413
798: 1 RVON21, RVON22, RVON31, RVON32, RVON33, RVON34, RVON55, RVON56 07950413
799: IF (IRECN .EQ. 02) IVCOMP = IVCOMP * 2 07960413
800: IF (RVON22 .EQ. -11.) IVCOMP = IVCOMP * 3 07970413
801: IF (RVON31 .EQ. 7.77) IVCOMP = IVCOMP * 5 07980413
802: 40190 IF (IVCOMP - 30) 20190, 10190, 20190 07990413
803: 30190 IVDELE = IVDELE + 1 08000413
804: WRITE (I02,80000) IVTNUM 08010413
805: IF (ICZERO) 10190, 0201, 20190 08020413
806: 10190 IVPASS = IVPASS + 1 08030413
807: WRITE (I02,80002) IVTNUM 08040413
808: GO TO 0201 08050413
809: 20190 IVFAIL = IVFAIL + 1 08060413
810: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08070413
811: 0201 CONTINUE 08080413
812: C 08090413
813: C **** FCVS PROGRAM 413 - TEST 020 **** 08100413
814: C 08110413
815: C 08120413
816: C TEST 020 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08130413
817: C VARIABLE OF LOGICAL TYPE. 08140413
818: C 08150413
819: C 08160413
820: IVTNUM = 20 08170413
821: IF (ICZERO) 30200, 0200, 30200 08180413
822: 0200 CONTINUE 08190413
823: LVONT1 = .FALSE. 08200413
824: LVONF6 = .TRUE. 08210413
825: IVCORR = 30 08220413
826: IVCOMP = 1 08230413
827: READ (I10, REC = 03) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08240413
828: 1 LVONT1, LVONF2, LVONT3, LVONF4, LVONT5, LVONF6, LVONT7, LVONF808250413
829: IF (IRECN .EQ. 03) IVCOMP = IVCOMP * 2 08260413
830: IF (.NOT. LVONF6) IVCOMP = IVCOMP * 3 08270413
831: IF (LVONT1) IVCOMP = IVCOMP * 5 08280413
832: 40200 IF (IVCOMP - 30) 20200, 10200, 20200 08290413
833: 30200 IVDELE = IVDELE + 1 08300413
834: WRITE (I02,80000) IVTNUM 08310413
835: IF (ICZERO) 10200, 0211, 20200 08320413
836: 10200 IVPASS = IVPASS + 1 08330413
837: WRITE (I02,80002) IVTNUM 08340413
838: GO TO 0211 08350413
839: 20200 IVFAIL = IVFAIL + 1 08360413
840: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08370413
841: 0211 CONTINUE 08380413
842: C 08390413
843: C **** FCVS PROGRAM 413 - TEST 021 **** 08400413
844: C 08410413
845: C 08420413
846: C TEST 021 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08430413
847: C ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO, AND THREE 08440413
848: C DIMENSION ARRAYS ARE USED. 08450413
849: C 08460413
850: C 08470413
851: IVTNUM = 21 08480413
852: IF (ICZERO) 30210, 0210, 30210 08490413
853: 0210 CONTINUE 08500413
854: IAON12(2) = 0 08510413
855: IAON12(8) = 0 08520413
856: IVCORR = 30 08530413
857: IVCOMP = 1 08540413
858: READ (I10, REC = 04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08550413
859: 1 IAON12(1), IAON12(2), IAON22(1,2), IAON22(2,2), IAON32(1,1,2), 08560413
860: 2 IAON32(2,1,2), IAON12(7), IAON12(8) 08570413
861: IF (IRECN .EQ. 04) IVCOMP = IVCOMP * 2 08580413
862: IF (IAON12(2) .EQ. -11) IVCOMP = IVCOMP * 3 08590413
863: IF (IAON12(8) .EQ. 32767) IVCOMP = IVCOMP * 5 08600413
864: C 08610413
865: C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 08620413
866: C FIELD VALUE AND A POSITIVE FIELD VALUE. 08630413
867: C 08640413
868: 40210 IF (IVCOMP - 30) 20210, 10210, 20210 08650413
869: 30210 IVDELE = IVDELE + 1 08660413
870: WRITE (I02,80000) IVTNUM 08670413
871: IF (ICZERO) 10210, 0221, 20210 08680413
872: 10210 IVPASS = IVPASS + 1 08690413
873: WRITE (I02,80002) IVTNUM 08700413
874: GO TO 0221 08710413
875: 20210 IVFAIL = IVFAIL + 1 08720413
876: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08730413
877: 0221 CONTINUE 08740413
878: C 08750413
879: C **** FCVS PROGRAM 413 - TEST 022 **** 08760413
880: C 08770413
881: C 08780413
882: C TEST 022 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08790413
883: C ARRAY ELEMENT OF REAL TYPE. ONE, TWO, AND THREE 08800413
884: C DIMENSION ARRAYS ARE USED. 08810413
885: C 08820413
886: C 08830413
887: IVTNUM = 22 08840413
888: IF (ICZERO) 30220, 0220, 30220 08850413
889: 0220 CONTINUE 08860413
890: RAON22(2,2) = 0.0 08870413
891: RAON32(1,1,2) = 0.0 08880413
892: IVCORR = 30 08890413
893: IVCOMP = 1 08900413
894: READ (I10, REC = 05) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08910413
895: 1 RAON12(1), RAON12(2), RAON22(1,2), RAON22(2,2), RAON32(1,1,2), 08920413
896: 2 RAON32(2,1,2), RAON12(7), RAON12(8) 08930413
897: IF (IRECN .EQ. 05) IVCOMP = IVCOMP * 2 08940413
898: IF (RAON22(2,2) .EQ. -7.77) IVCOMP = IVCOMP * 3 08950413
899: IF (RAON32(1,1,2) .EQ. .512 ) IVCOMP = IVCOMP * 5 08960413
900: C 08970413
901: C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 08980413
902: C FIELD VALUE AND A POSITIVE FIELD VALUE. 08990413
903: C 09000413
904: 40220 IF (IVCOMP - 30) 20220, 10220, 20220 09010413
905: 30220 IVDELE = IVDELE + 1 09020413
906: WRITE (I02,80000) IVTNUM 09030413
907: IF (ICZERO) 10220, 0231, 20220 09040413
908: 10220 IVPASS = IVPASS + 1 09050413
909: WRITE (I02,80002) IVTNUM 09060413
910: GO TO 0231 09070413
911: 20220 IVFAIL = IVFAIL + 1 09080413
912: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09090413
913: 0231 CONTINUE 09100413
914: C 09110413
915: C **** FCVS PROGRAM 413 - TEST 023 **** 09120413
916: C 09130413
917: C 09140413
918: C TEST 023 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09150413
919: C ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO, AND THREE 09160413
920: C DIMENSION ARRAYS ARE USED. 09170413
921: C 09180413
922: C 09190413
923: IVTNUM = 23 09200413
924: IF (ICZERO) 30230, 0230, 30230 09210413
925: 0230 CONTINUE 09220413
926: LAON12(1) = .FALSE. 09230413
927: LAON32(2,1,2) = .TRUE. 09240413
928: IVCORR = 30 09250413
929: IVCOMP = 1 09260413
930: READ (I10, REC = 06) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09270413
931: 1 LAON12(1), LAON12(2), LAON22(1,2), LAON22(2,2), LAON32(1,1,2), 09280413
932: 2 LAON32(2,1,2), LAON12(7), LAON12(8) 09290413
933: IF (IRECN .EQ. 06) IVCOMP = IVCOMP * 2 09300413
934: IF (LAON12(1)) IVCOMP = IVCOMP * 3 09310413
935: IF (.NOT. LAON32(2,1,2)) IVCOMP = IVCOMP * 5 09320413
936: 40230 IF (IVCOMP - 30) 20230, 10230, 20230 09330413
937: 30230 IVDELE = IVDELE + 1 09340413
938: WRITE (I02,80000) IVTNUM 09350413
939: IF (ICZERO) 10230, 0241, 20230 09360413
940: 10230 IVPASS = IVPASS + 1 09370413
941: WRITE (I02,80002) IVTNUM 09380413
942: GO TO 0241 09390413
943: 20230 IVFAIL = IVFAIL + 1 09400413
944: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09410413
945: 0241 CONTINUE 09420413
946: C 09430413
947: C **** FCVS PROGRAM 413 - TEST 024 **** 09440413
948: C 09450413
949: C 09460413
950: C TEST 024 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09470413
951: C ARRAY OF INTEGER TYPE. 09480413
952: C 09490413
953: C 09500413
954: IVTNUM = 24 09510413
955: IF (ICZERO) 30240, 0240, 30240 09520413
956: 0240 CONTINUE 09530413
957: IAON32(2,1,1) = 0 09540413
958: IAON32(2,2,2) = 0 09550413
959: IVCORR = 30 09560413
960: IVCOMP = 1 09570413
961: READ (I10, REC = 07) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09580413
962: 1 IAON32 09590413
963: IF (IRECN .EQ. 07) IVCOMP = IVCOMP * 2 09600413
964: IF (IAON32(2,1,1) .EQ. -11) IVCOMP = IVCOMP * 3 09610413
965: IF (IAON32(2,2,2) .EQ. 32767) IVCOMP = IVCOMP * 5 09620413
966: C 09630413
967: C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 09640413
968: C FIELD VALUE AND A POSITIVE FIELD VALUE. 09650413
969: C 09660413
970: 40240 IF (IVCOMP - 30) 20240, 10240, 20240 09670413
971: 30240 IVDELE = IVDELE + 1 09680413
972: WRITE (I02,80000) IVTNUM 09690413
973: IF (ICZERO) 10240, 0251, 20240 09700413
974: 10240 IVPASS = IVPASS + 1 09710413
975: WRITE (I02,80002) IVTNUM 09720413
976: GO TO 0251 09730413
977: 20240 IVFAIL = IVFAIL + 1 09740413
978: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09750413
979: 0251 CONTINUE 09760413
980: C 09770413
981: C **** FCVS PROGRAM 413 - TEST 025 **** 09780413
982: C 09790413
983: C 09800413
984: C TEST 025 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09810413
985: C ARRAY OF REAL TYPE. 09820413
986: C 09830413
987: C 09840413
988: IVTNUM = 25 09850413
989: IF (ICZERO) 30250, 0250, 30250 09860413
990: 0250 CONTINUE 09870413
991: RAON32(2,1,1) = 0.0 09880413
992: RAON32(2,2,2) = 0.0 09890413
993: IVCORR = 30 09900413
994: IVCOMP = 1 09910413
995: READ (I10, REC = 08) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09920413
996: 1 RAON32 09930413
997: IF (IRECN .EQ. 08) IVCOMP = IVCOMP * 2 09940413
998: IF (RAON32(2,1,1) .EQ. -11.) IVCOMP = IVCOMP * 3 09950413
999: IF (RAON32(2,2,2) .EQ. 32767.) IVCOMP = IVCOMP * 5 09960413
1000: C 09970413
1001: C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 09980413
1002: C FIELD VALUE AND A POSITIVE FIELD VALUE. 09990413
1003: C 10000413
1004: 40250 IF (IVCOMP - 30) 20250, 10250, 20250 10010413
1005: 30250 IVDELE = IVDELE + 1 10020413
1006: WRITE (I02,80000) IVTNUM 10030413
1007: IF (ICZERO) 10250, 0261, 20250 10040413
1008: 10250 IVPASS = IVPASS + 1 10050413
1009: WRITE (I02,80002) IVTNUM 10060413
1010: GO TO 0261 10070413
1011: 20250 IVFAIL = IVFAIL + 1 10080413
1012: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10090413
1013: 0261 CONTINUE 10100413
1014: C 10110413
1015: C **** FCVS PROGRAM 413 - TEST 026 **** 10120413
1016: C 10130413
1017: C 10140413
1018: C TEST 026 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10150413
1019: C ARRAY OF LOGICAL TYPE. 10160413
1020: C 10170413
1021: C 10180413
1022: IVTNUM = 26 10190413
1023: IF (ICZERO) 30260, 0260, 30260 10200413
1024: 0260 CONTINUE 10210413
1025: LAON32(1,1,1) = .FALSE. 10220413
1026: LAON32(2,2,2) = .TRUE. 10230413
1027: IVCORR = 30 10240413
1028: IVCOMP = 1 10250413
1029: READ (I10, REC = 09) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10260413
1030: 1 LAON32 10270413
1031: IF (IRECN .EQ. 09) IVCOMP = IVCOMP * 2 10280413
1032: IF (LAON32(1,1,1)) IVCOMP = IVCOMP * 3 10290413
1033: IF (.NOT. LAON32(2,2,2)) IVCOMP = IVCOMP * 5 10300413
1034: 40260 IF (IVCOMP - 30) 20260, 10260, 20260 10310413
1035: 30260 IVDELE = IVDELE + 1 10320413
1036: WRITE (I02,80000) IVTNUM 10330413
1037: IF (ICZERO) 10260, 0271, 20260 10340413
1038: 10260 IVPASS = IVPASS + 1 10350413
1039: WRITE (I02,80002) IVTNUM 10360413
1040: GO TO 0271 10370413
1041: 20260 IVFAIL = IVFAIL + 1 10380413
1042: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10390413
1043: 0271 CONTINUE 10400413
1044: C 10410413
1045: C **** FCVS PROGRAM 413 - TEST 027 **** 10420413
1046: C 10430413
1047: C 10440413
1048: C TEST 027 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10450413
1049: C IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. THE STORAGE VALUES IN 10460413
1050: C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 10470413
1051: C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD 10480413
1052: C OF THE FILE. THIS RECORD IS RECORD NUMBER 10 AND WAS CREATED IN 10490413
1053: C TEST 012 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN 10500413
1054: C ARRAY IAON32 AND SUBSCRIPT VALUE AFTER THE READ IS 10510413
1055: C 10520413
1056: C VALUE 11 777 512 -32767 -11 -777 -512 32767 10530413
1057: C FIELD POS 1 3 2 4 5 7 6 8 10540413
1058: C IAON32 1 2 3 4 5 6 7 8 10550413
1059: C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,210560413
1060: C 10570413
1061: C 10580413
1062: IVTNUM = 27 10590413
1063: IF (ICZERO) 30270, 0270, 30270 10600413
1064: 0270 CONTINUE 10610413
1065: IAON32(2,1,1) = 0 10620413
1066: IAON32(2,2,1) = 0 10630413
1067: IVCORR = 30 10640413
1068: IVCOMP = 1 10650413
1069: READ (I10, REC = 10) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10660413
1070: 1 (((IAON32 (J,K,I), K=1,2), J=1,2), I=1,2) 10670413
1071: IF (IRECN .EQ. 10) IVCOMP = IVCOMP * 2 10680413
1072: IF (IAON32(2,1,1) .EQ. 777) IVCOMP = IVCOMP * 3 10690413
1073: IF (IAON32(2,2,1) .EQ. -32767) IVCOMP = IVCOMP * 5 10700413
1074: C 10710413
1075: C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 10720413
1076: C FIELD VALUE AND A POSITIVE FIELD VALUE. 10730413
1077: C 10740413
1078: 40270 IF (IVCOMP - 30) 20270, 10270, 20270 10750413
1079: 30270 IVDELE = IVDELE + 1 10760413
1080: WRITE (I02,80000) IVTNUM 10770413
1081: IF (ICZERO) 10270, 0281, 20270 10780413
1082: 10270 IVPASS = IVPASS + 1 10790413
1083: WRITE (I02,80002) IVTNUM 10800413
1084: GO TO 0281 10810413
1085: 20270 IVFAIL = IVFAIL + 1 10820413
1086: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10830413
1087: 0281 CONTINUE 10840413
1088: C 10850413
1089: C **** FCVS PROGRAM 413 - TEST 028 **** 10860413
1090: C 10870413
1091: C 10880413
1092: C TEST 028 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10890413
1093: C IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE STORAGE VALUES IN 10900413
1094: C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 10910413
1095: C SEQUENCE THE SAME AS FOUND IN THE RECORD OF THE FILE. THIS REC- 10920413
1096: C ORD IS RECORD NUMBER 011 AND WAS CREATED IN TEST 013 ABOVE. 10930413
1097: C THE FIELD VALUE, FIELD POSITION, POSITION WITHIN ARRAY RAON32 AND10940413
1098: C SUBSCRIPT VALUE AFTER THE THE READ IS 10950413
1099: C 10960413
1100: C VALUE 11. -11. 7.77 -7.77 .512 -.512 -32767. 32767.10970413
1101: C FIELD POS 1 2 3 4 5 6 7 8 10980413
1102: C RAON32 1 2 3 4 5 6 7 8 10990413
1103: C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,211000413
1104: C 11010413
1105: C 11020413
1106: IVTNUM = 28 11030413
1107: IF (ICZERO) 30280, 0280, 30280 11040413
1108: 0280 CONTINUE 11050413
1109: RAON32(1,2,1) = 0.0 11060413
1110: RAON32(1,2,2) = 0.0 11070413
1111: IVCORR = 30 11080413
1112: IVCOMP = 1 11090413
1113: READ (I10, REC = 11) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 11100413
1114: 1 (((RAON32 (J,K,I), J=1,2), K=1,2), I=1,2) 11110413
1115: IF (IRECN .EQ. 11) IVCOMP = IVCOMP * 2 11120413
1116: IF (RAON32(1,2,1) .EQ. 7.77) IVCOMP = IVCOMP * 3 11130413
1117: IF (RAON32(1,2,2) .EQ. -32767.) IVCOMP = IVCOMP * 5 11140413
1118: C 11150413
1119: C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 11160413
1120: C FIELD VALUE AND A POSITIVE FIELD VALUE. 11170413
1121: C 11180413
1122: 40280 IF (IVCOMP - 30) 20280, 10280, 20280 11190413
1123: 30280 IVDELE = IVDELE + 1 11200413
1124: WRITE (I02,80000) IVTNUM 11210413
1125: IF (ICZERO) 10280, 0291, 20280 11220413
1126: 10280 IVPASS = IVPASS + 1 11230413
1127: WRITE (I02,80002) IVTNUM 11240413
1128: GO TO 0291 11250413
1129: 20280 IVFAIL = IVFAIL + 1 11260413
1130: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11270413
1131: 0291 CONTINUE 11280413
1132: C 11290413
1133: C **** FCVS PROGRAM 413 - TEST 029 **** 11300413
1134: C 11310413
1135: C 11320413
1136: C TEST 029 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 11330413
1137: C IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. THE STORAGE VALUES IN 11340413
1138: C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 11350413
1139: C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD 11360413
1140: C OF THE FILE. THIS RECORD IS RECORD NUMBER 12 AND WAS CREATED IN 11370413
1141: C TEST 014 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN 11380413
1142: C ARRAY LAON32 AND SUBSCRIPT VALUE AFTER THE READ IS 11390413
1143: C 11400413
1144: C VALUE T T F F T T F F 11410413
1145: C FIELD POS 1 5 3 7 2 6 4 8 11420413
1146: C LAON32 1 2 3 4 5 6 7 8 11430413
1147: C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,211440413
1148: C 11450413
1149: C 11460413
1150: IVTNUM = 29 11470413
1151: IF (ICZERO) 30290, 0290, 30290 11480413
1152: 0290 CONTINUE 11490413
1153: LAON32(1,2,1) = .TRUE. 11500413
1154: LAON32(2,1,1) = .FALSE. 11510413
1155: IVCORR = 30 11520413
1156: IVCOMP = 1 11530413
1157: READ (I10, REC = 12) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 11540413
1158: 1 (((LAON32 (J,K,I), I=1,2), K=1,2), J=1,2) 11550413
1159: IF (IRECN .EQ. 12) IVCOMP = IVCOMP * 2 11560413
1160: IF ( .NOT. LAON32(1,2,1)) IVCOMP = IVCOMP * 3 11570413
1161: IF (LAON32(2,1,1)) IVCOMP = IVCOMP * 5 11580413
1162: 40290 IF (IVCOMP - 30) 20290, 10290, 20290 11590413
1163: 30290 IVDELE = IVDELE + 1 11600413
1164: WRITE (I02,80000) IVTNUM 11610413
1165: IF (ICZERO) 10290, 0301, 20290 11620413
1166: 10290 IVPASS = IVPASS + 1 11630413
1167: WRITE (I02,80002) IVTNUM 11640413
1168: GO TO 0301 11650413
1169: 20290 IVFAIL = IVFAIL + 1 11660413
1170: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11670413
1171: 0301 CONTINUE 11680413
1172: C 11690413
1173: C **** FCVS PROGRAM 413 - TEST 030 **** 11700413
1174: C 11710413
1175: C 11720413
1176: C TEST 030 USES A READ STATEMENT WITHOUT ANY INPUT LIST ITEMS 11730413
1177: C (INPUT LIST ITEMS ARE OPTIONAL FOR THE READ STATEMENT). THIS 11740413
1178: C RECORD WAS WRITTEN IN TEST 14 AND SHOULD BE RECORD NUMBER 13. 11750413
1179: C THE PURPOSE OF THIS TEST IS TO SEE THAT THE STATEMENT CONSTRUCT 11760413
1180: C IS ACCEPTABLE TO THE COMPILER. 11770413
1181: C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO. 11780413
1182: C 11790413
1183: C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS 11800413
1184: C 12.8, READ, WRITE AND PRINT STATEMENTS11810413
1185: C 11820413
1186: C 11830413
1187: IVTNUM = 30 11840413
1188: IF (ICZERO) 30300, 0300, 30300 11850413
1189: 0300 CONTINUE 11860413
1190: IRECN = 13 11870413
1191: IVCORR = 13 11880413
1192: READ (I10, REC = 13) 11890413
1193: IVCOMP = IRECN 11900413
1194: 40300 IF (IVCOMP - 13) 20300, 10300, 20300 11910413
1195: 30300 IVDELE = IVDELE + 1 11920413
1196: WRITE (I02,80000) IVTNUM 11930413
1197: IF (ICZERO) 10300, 0311, 20300 11940413
1198: 10300 IVPASS = IVPASS + 1 11950413
1199: WRITE (I02,80002) IVTNUM 11960413
1200: GO TO 0311 11970413
1201: 20300 IVFAIL = IVFAIL + 1 11980413
1202: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11990413
1203: 0311 CONTINUE 12000413
1204: C 12010413
1205: C **** FCVS PROGRAM 413 - TEST 031 **** 12020413
1206: C 12030413
1207: C 12040413
1208: C TEST 031 USES A READ STATEMENT IN WHICH THE NUMBER OF VALUES 12050413
1209: C REQUIRED BY THE INPUT LIST IS LESS THAN THE NUMBER OF VALUES IN 12060413
1210: C THE RECORD. 12070413
1211: C 12080413
1212: C SEE SECTION 12.9.5.1, UNFORMATED DATA TRANSFER 12090413
1213: C 12100413
1214: C 12110413
1215: IVTNUM = 31 12120413
1216: IF (ICZERO) 30310, 0310, 30310 12130413
1217: 0310 CONTINUE 12140413
1218: IVON21 = 0 12150413
1219: IVON22 = 0 12160413
1220: IVON31 = 0 12170413
1221: IVCORR = 0 12180413
1222: IVCOMP = 1 12190413
1223: READ (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12200413
1224: 1 IVON21, IVON22, IVON31 12210413
1225: IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 12220413
1226: IF (IVON21 .EQ. 11) IVCOMP = IVCOMP * 3 12230413
1227: IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 5 12240413
1228: 40310 IF (IVCOMP - 30) 20310, 10310, 20310 12250413
1229: 30310 IVDELE = IVDELE + 1 12260413
1230: WRITE (I02,80000) IVTNUM 12270413
1231: IF (ICZERO) 10310, 0321, 20310 12280413
1232: 10310 IVPASS = IVPASS + 1 12290413
1233: WRITE (I02,80002) IVTNUM 12300413
1234: GO TO 0321 12310413
1235: 20310 IVFAIL = IVFAIL + 1 12320413
1236: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12330413
1237: 0321 CONTINUE 12340413
1238: C 12350413
1239: C 12360413
1240: C TEST 032 AND 033 VERIFIES THAT RECORDS MAY BE READ IN ANY ORDER12370413
1241: C ALSO THAT A VARIABLE MAY BE USED AS THE OPERAND OF THE REC SPEC- 12380413
1242: C IFIER FOR A READ STATEMENT. 12390413
1243: C 12400413
1244: C SEE SECTION 2.2.4.2(1) , DIRECT ACCESS 12410413
1245: C 12420413
1246: C 12430413
1247: C 12440413
1248: C **** FCVS PROGRAM 413 - TEST 032 **** 12450413
1249: C 12460413
1250: C 12470413
1251: C TEST 032 READS THE RECORDS WRITTEN IN TEST 16. EVERY OTHER 12480413
1252: C RECORD IS READ FOR A TOTAL OF 100 RECORDS (THE REC SPECIFIER 12490413
1253: C VARIABLE IS INCREMENTED BY 2). 12500413
1254: C 12510413
1255: C 12520413
1256: IVTNUM = 32 12530413
1257: IF (ICZERO) 30320, 0320, 30320 12540413
1258: 0320 CONTINUE 12550413
1259: IRECCK = 13 12560413
1260: IRECN = 0 12570413
1261: IREC = 13 12580413
1262: IVCOMP = 0 12590413
1263: DO 4134 I = 1,100 12600413
1264: IREC = IREC + 2 12610413
1265: IRECCK = IRECCK + 2 12620413
1266: READ (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12630413
1267: 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 12640413
1268: IF (IRECN .EQ. IRECCK) IVCOMP = IVCOMP + 1 12650413
1269: 4134 CONTINUE 12660413
1270: IVCORR = 100 12670413
1271: 40320 IF (IVCOMP - 100) 20320, 10320, 20320 12680413
1272: 30320 IVDELE = IVDELE + 1 12690413
1273: WRITE (I02,80000) IVTNUM 12700413
1274: IF (ICZERO) 10320, 0331, 20320 12710413
1275: 10320 IVPASS = IVPASS + 1 12720413
1276: WRITE (I02,80002) IVTNUM 12730413
1277: GO TO 0331 12740413
1278: 20320 IVFAIL = IVFAIL + 1 12750413
1279: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12760413
1280: 0331 CONTINUE 12770413
1281: C 12780413
1282: C **** FCVS PROGRAM 413 - TEST 033 **** 12790413
1283: C 12800413
1284: C 12810413
1285: C TEST 033 READS THE RECORDS WRITTEN IN TEST 17. THIS TEST IS 12820413
1286: C SIMILAR TO TEST 32 ABOVE EXCEPT THE FILE IS READ IN REVERSE 12830413
1287: C RECORD NUMBER ORDER. 12840413
1288: C 12850413
1289: C 12860413
1290: IVTNUM = 33 12870413
1291: IF (ICZERO) 30330, 0330, 30330 12880413
1292: 0330 CONTINUE 12890413
1293: IRECCK = 216 12900413
1294: IRECN = 0 12910413
1295: IVCOMP = 0 12920413
1296: IREC = 216 12930413
1297: DO 4135 I = 1,100 12940413
1298: IREC = IREC - 2 12950413
1299: IRECCK = IRECCK - 2 12960413
1300: READ (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12970413
1301: 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 12980413
1302: IF (IRECN .EQ. IRECCK) IVCOMP = IVCOMP + 1 12990413
1303: 4135 CONTINUE 13000413
1304: IVCORR = 100 13010413
1305: 40330 IF (IVCOMP - 100) 20330, 10330, 20330 13020413
1306: 30330 IVDELE = IVDELE + 1 13030413
1307: WRITE (I02,80000) IVTNUM 13040413
1308: IF (ICZERO) 10330, 0341, 20330 13050413
1309: 10330 IVPASS = IVPASS + 1 13060413
1310: WRITE (I02,80002) IVTNUM 13070413
1311: GO TO 0341 13080413
1312: 20330 IVFAIL = IVFAIL + 1 13090413
1313: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 13100413
1314: 0341 CONTINUE 13110413
1315: C 13120413
1316: C **** FCVS PROGRAM 413 - TEST 034 **** 13130413
1317: C 13140413
1318: C 13150413
1319: C TEST 034 VERIFIES THAT THE VALUES OF A RECORD MAY BE CHANGED 13160413
1320: C WHEN THE RECORD IS REWRITTEN. RECORD NUMBER 01 IS USED FOR 13170413
1321: C TESTING. THE RECORD WAS WRITTEN IN TEST 02 AND READ IN TEST 18. 13180413
1322: C A RECORD CANNOT BE DELETED FROM THE FILE BUT IT CAN BE REWRITTEN. 13190413
1323: C 13200413
1324: C SEE SECTION 12.2.4.2 (5), DIRECT ACCESS 13210413
1325: C 13220413
1326: C 13230413
1327: IVTNUM = 34 13240413
1328: IF (ICZERO) 30340, 0340, 30340 13250413
1329: 0340 CONTINUE 13260413
1330: IRECN = 01 13270413
1331: WRITE (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 13280413
1332: 1 ICON31, ICON32, ICON21, ICON22, ICON55, ICON56, ICON33, ICON3413290413
1333: READ (I10, REC=01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 13300413
1334: 1 IVON61, IVON62, IVON63, IVON64, IVON65,IVON66, IVON67, IVON68 13310413
1335: IVCORR = 210 13320413
1336: IVCOMP = 1 13330413
1337: IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 13340413
1338: IF (IVON61 .EQ. 777) IVCOMP = IVCOMP * 3 13350413
1339: IF (IVON62 .EQ. -777) IVCOMP = IVCOMP * 5 13360413
1340: IF (IVON66 .EQ. 32767) IVCOMP = IVCOMP * 7 13370413
1341: 40340 IF (IVCOMP - 210) 20340, 10340, 20340 13380413
1342: 30340 IVDELE = IVDELE + 1 13390413
1343: WRITE (I02,80000) IVTNUM 13400413
1344: IF (ICZERO) 10340, 0351, 20340 13410413
1345: 10340 IVPASS = IVPASS + 1 13420413
1346: WRITE (I02,80002) IVTNUM 13430413
1347: GO TO 0351 13440413
1348: 20340 IVFAIL = IVFAIL + 1 13450413
1349: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 13460413
1350: 0351 CONTINUE 13470413
1351: C 13480413
1352: C 13490413
1353: C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES 13500413
1354: C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION 13510413
1355: C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM. 13520413
1356: C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED13530413
1357: C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS 13540413
1358: C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL 13550413
1359: C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP 13560413
1360: C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST 13570413
1361: C REPORT AND BEFORE THE TEST REPORT SUMMARY. 13580413
1362: C 13590413
1363: CDB** BEGIN FILE DUMP CODE 13600413
1364: C ITOTR = 214 13610413
1365: C ILUN = I10 13620413
1366: C IRLGN = 80 13630413
1367: C IRNUM = 1 13640413
1368: C7701 FORMAT (80A1) 13650413
1369: C7702 FORMAT (1X,80A1) 13660413
1370: C7703 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,13H RECORDS - OK) 13670413
1371: C7704 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,27H RECORDS - THERE SHOULD BE ,I13680413
1372: C 13,9H RECORDS.) 13690413
1373: C DO 7771 IRNUM = 1, ITOTR 13700413
1374: C READ (ILUN, REC = IRNUM) (IDUMP(ICH), ICH = 1, IRLGN) 13710413
1375: C WRITE (I02, 7702) (IDUMP(ICH), ICH = 1, IRLGN) 13720413
1376: C7771 CONTINUE 13730413
1377: CDE** END OF DUMP CODE 13740413
1378: C TEST 034 IS THE LAST TEST IN THIS PROGRAM. THE ROUTINE SHOULD13750413
1379: C HAVE MADE 34 EXPLICIT TESTS AND PROCESSED ONE FILE CONNECTED FOR 13760413
1380: C DIRECT ACCESS 13770413
1381: C 13780413
1382: C 13790413
1383: C 13800413
1384: C WRITE OUT TEST SUMMARY 13810413
1385: C 13820413
1386: WRITE (I02,90004) 13830413
1387: WRITE (I02,90014) 13840413
1388: WRITE (I02,90004) 13850413
1389: WRITE (I02,90000) 13860413
1390: WRITE (I02,90004) 13870413
1391: WRITE (I02,90020) IVFAIL 13880413
1392: WRITE (I02,90022) IVPASS 13890413
1393: WRITE (I02,90024) IVDELE 13900413
1394: STOP 13910413
1395: 90001 FORMAT (1H ,24X,5HFM413) 13920413
1396: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM413) 13930413
1397: C 13940413
1398: C FORMATS FOR TEST DETAIL LINES 13950413
1399: C 13960413
1400: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 13970413
1401: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 13980413
1402: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 13990413
1403: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 14000413
1404: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 14010413
1405: C 14020413
1406: C FORMAT STATEMENTS FOR PAGE HEADERS 14030413
1407: C 14040413
1408: 90002 FORMAT (1H1) 14050413
1409: 90004 FORMAT (1H ) 14060413
1410: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 14070413
1411: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 14080413
1412: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 14090413
1413: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 14100413
1414: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 14110413
1415: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 14120413
1416: C 14130413
1417: C FORMAT STATEMENTS FOR RUN SUMMARY 14140413
1418: C 14150413
1419: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 14160413
1420: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 14170413
1421: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 14180413
1422: END 14190413
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.