![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM402.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 FM402.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 FM402 00010402
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 00020402
6: C 00030402
7: C 00040402
8: C THIS ROUTINE TESTS THE A(W) (W IS SIZE OF FIELD IN CHARACTERS)00050402
9: C EDIT DESCRIPTOR OF THE FORMAT SPECIFICATION BOTH WITH AND WITHOUT 00060402
10: C THE OPTIONAL W. THE A EDIT DESCRIPTOR IS USED WITH AN INPUT/ 00070402
11: C OUTPUT LIST ITEM OF TYPE CHARACTER. IF A FIELD WIDTH W IS SPECI- 00080402
12: C FIED WITH THE A EDIT DESCRIPTOR THE FIELD CONSISTS OF W CHARAC- 00090402
13: C TERS. IF A FIELD WIDTH W IS NOT SPECIFIED WITH THE A EDIT DES- 00100402
14: C CRIPTOR, THE NUMBER OF CHARACTERS IN THE FIELD IS THE LENGTH OF 00110402
15: C THE CHARACTER INPUT/OUTPUT LIST ITEM. THIS ROUTINE FIRST 00120402
16: C TESTS FOR PROPER EDITING OF CHARACTER DATA ON OUTPUT BY DIRECTING00130402
17: C THE EDITED RESULT TO A PRINT FILE. RESULTS OF THIS SET OF 00140402
18: C TESTS MUST BE VISUALLY CHECKED FOR CORRECTNESS. NEXT AN EXTERNAL 00150402
19: C FILE CONNECTED FOR SEQUENTIAL ACCESS IS CREATED WITH CHARACTER 00160402
20: C DATA. FINALLY THE FILE IS REWOUND AND READ WITH THE A(W) EDIT 00170402
21: C DESCRIPTOR AND CHECKED FOR PROPER EDITING ON INPUT. 00180402
22: C 00190402
23: C THIS ROUTINE TESTS FOR PROPER EDITING BY 00200402
24: C 00210402
25: C (1) THE A EDIT DESCRIPTOR WITHOUT THE OPTIONAL W ON BOTH INPUT00220402
26: C AND OUTPUT, 00230402
27: C 00240402
28: C (2) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT00250402
29: C LIST ITEM IS LESS THAN THE WIDTH W, 00260402
30: C 00270402
31: C (3) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT00280402
32: C LIST ITEM IS BOTH EQUAL TO AND GREATER THAN THE WIDTH W, 00290402
33: C 00300402
34: C (4) THE A EDIT DESCRIPTOR WHEN USED WITH THE OPTIONAL REPEAT 00310402
35: C SPECIFICATION. 00320402
36: C 00330402
37: C REFERENCES - 00340402
38: C 00350402
39: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00360402
40: C X3.9-1978 00370402
41: C 00380402
42: C SECTION 3.1, FORTRAN CHARACTER SET 00390402
43: C SECTION 4.8, CHARACTER TYPE 00400402
44: C SECTION 8.4.2, CHARACTER TYPE-STATEMENT 00410402
45: C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT 00420402
46: C SECTION 13.5.11, A EDITING 00430402
47: C 00440402
48: C 00450402
49: C 00460402
50: C 00470402
51: C ******************************************************************00480402
52: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00490402
53: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00500402
54: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00510402
55: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00520402
56: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00530402
57: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00540402
58: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00550402
59: C THE RESULT OF EXECUTING THESE TESTS. 00560402
60: C 00570402
61: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00580402
62: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00590402
63: C 00600402
64: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00610402
65: C DEPARTMENT OF THE NAVY 00620402
66: C FEDERAL COBOL COMPILER TESTING SERVICE 00630402
67: C WASHINGTON, D.C. 20376 00640402
68: C 00650402
69: C ******************************************************************00660402
70: C 00670402
71: C 00680402
72: IMPLICIT LOGICAL (L) 00690402
73: IMPLICIT CHARACTER*14 (C) 00700402
74: C 00710402
75: DIMENSION IDUMP (80) 00720402
76: DIMENSION CATN11(46), CATN12(5), CATN31(2,3,2), CATN14(46) 00730402
77: CHARACTER CATN11*1, CVTN11*1, CATN12*5, CATN31*1 00740402
78: CHARACTER CVTN12*10, CVTN13*2, CATN14*1, CCTN15*50, CVTN15*50 00750402
79: CHARACTER CVTN01*1 00760402
80: 00770402
81: DATA CATN14 /46*' '/ 00780402
82: DATA CCTN15 /'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789'/00790402
83: DATA CATN11 / '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 00800402
84: 1'=', '+', '-','*', '/', '(', ')', ',', '.', '''','A', 'B', 'C', 00810402
85: 2'D', 'E', 'F','G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 00820402
86: 3'Q', 'R', 'S','T', 'U', 'V', 'W', 'X', 'Y', 'Z'/ 00830402
87: DATA CATN12 /'ABMYZ', '01589', '=+-()','A5+Z.' ,'1''A,4'/ 00840402
88: 00850402
89: C 00860402
90: C 00870402
91: C 00880402
92: C INITIALIZATION SECTION. 00890402
93: C 00900402
94: C INITIALIZE CONSTANTS 00910402
95: C ******************** 00920402
96: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00930402
97: I01 = 5 00940402
98: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00950402
99: I02 = 6 00960402
100: C SYSTEM ENVIRONMENT SECTION 00970402
101: C 00980402
102: I01 = 5 00990402
103: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01000402
104: C (UNIT NUMBER FOR CARD READER). 01010402
105: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01020402
106: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01030402
107: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01040402
108: C 01050402
109: I02 = 6 01060402
110: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01070402
111: C (UNIT NUMBER FOR PRINTER). 01080402
112: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01090402
113: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01100402
114: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01110402
115: C 01120402
116: IVPASS = 0 01130402
117: IVFAIL = 0 01140402
118: IVDELE = 0 01150402
119: ICZERO = 0 01160402
120: C 01170402
121: C WRITE OUT PAGE HEADERS 01180402
122: C 01190402
123: WRITE (I02,90002) 01200402
124: WRITE (I02,90006) 01210402
125: WRITE (I02,90008) 01220402
126: WRITE (I02,90004) 01230402
127: WRITE (I02,90010) 01240402
128: WRITE (I02,90004) 01250402
129: WRITE (I02,90016) 01260402
130: WRITE (I02,90001) 01270402
131: WRITE (I02,90004) 01280402
132: WRITE (I02,90012) 01290402
133: WRITE (I02,90014) 01300402
134: WRITE (I02,90004) 01310402
135: C 01320402
136: C 01330402
137: C 01340402
138: C TEST 001 THROUGH 014 TESTS THE EDIT DESCRIPTOR FOR PROPER 01350402
139: C EDITING OF CHARACTER DATA ON OUTPUT. TO VALIDATE THESE TESTS 01360402
140: C THE EDITED DATA IS SENT TO A PRINT FILE AND THEREFORE MUST BE 01370402
141: C VISUALLY CHECKED FOR CORRECTNESS. ON OUTPUT THE EDITED FIELD 01380402
142: C SIZE IS AW WHERE W IS NUMBER OF POSITIONS IN THE FIELD OR 01390402
143: C IS THE SIZE OF THE OUTPUT DATUM ITEM. SEE SECTION 13.5.11 A 01400402
144: C EDITING 01410402
145: C 01420402
146: C 01430402
147: 80052 FORMAT (1H ,4X,48HTESTS 001 THROUGH 014 MUST BE VISUALLY VERIFIED.01440402
148: 1) 01450402
149: 80054 FORMAT (1H ,56HIMMEDIATELY FOLLOWING THIS NARRATIVE IS A REFERENCE01460402
150: 1 LINE) 01470402
151: 80056 FORMAT (1H ,52HOF THE FORM '123456 ...'. THE REFERENCE LINE IS T01480402
152: 1O) 01490402
153: 80058 FORMAT (1H ,49HAID IN THE VISUAL VERIFICATION OF THE TESTS. FOR) 01500402
154: 80062 FORMAT (1H ,50HTHE OUTPUT TO BE CORRECT THE DATA VALUES DISPLAYED 01510402
155: 1) 01520402
156: 80064 FORMAT (1H ,54HIN THE COMPUTED COLUMN MUST MATCH THAT IN THE CORRE01530402
157: 1CT ) 01540402
158: 80066 FORMAT (1H ,44HCOLUMN IN BOTH VALUE AND CHARACTER POSITION.) 01550402
159: 80072 FORMAT (1H ,26HREFERENCE LINE - ,10H1234567890,5X,10H123401560402
160: 1567890) 01570402
161: WRITE (I02,80052) 01580402
162: WRITE (I02,80054) 01590402
163: WRITE (I02,80056) 01600402
164: WRITE (I02,80058) 01610402
165: WRITE (I02,80062) 01620402
166: WRITE (I02,80064) 01630402
167: WRITE (I02,80066) 01640402
168: WRITE (I02,90004) 01650402
169: WRITE (I02,80072) 01660402
170: C 01670402
171: C **** FCVS PROGRAM 402 - TEST 001 **** 01680402
172: C 01690402
173: C TEST 001 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 01700402
174: C ON OUTPUT WHERE THE FIELD IS 1 POSITION IN LENGTH, THE 01710402
175: C VALUE OF THE DATUM IS LETTERS AND THE OUTPUT LIST ITEM IS A 01720402
176: C VARIABLE. 01730402
177: C 01740402
178: IVTNUM = 001 01750402
179: IF (ICZERO) 30010, 0010, 30010 01760402
180: 0010 CONTINUE 01770402
181: CVTN01 = 'A' 01780402
182: 0012 FORMAT (1H ,4X,I5,26X,A,14X,1HA) 01790402
183: WRITE (I02, 0012) IVTNUM, CVTN01 01800402
184: GO TO 0021 01810402
185: 30010 IVDELE = IVDELE + 1 01820402
186: WRITE (I02,80000) IVTNUM 01830402
187: 0021 CONTINUE 01840402
188: C 01850402
189: C **** FCVS PROGRAM 402 - TEST 002 **** 01860402
190: C 01870402
191: C TEST 002 IS SIMILAR TO TEST 001 EXCEPT THAT THE OUTPUT LIST 01880402
192: C ITEM IS AN ARRAY ELEMENT. 01890402
193: C 01900402
194: IVTNUM = 002 01910402
195: IF (ICZERO) 30020, 0020, 30020 01920402
196: 0020 CONTINUE 01930402
197: CATN31 (1,2,1) = 'Z' 01940402
198: 0022 FORMAT (1H ,4X,I5,26X,A,14X,1HZ) 01950402
199: WRITE (I02, 0022) IVTNUM, CATN31 (1,2,1) 01960402
200: GO TO 0031 01970402
201: 30020 IVDELE = IVDELE + 1 01980402
202: WRITE (I02,80000) IVTNUM 01990402
203: 0031 CONTINUE 02000402
204: C 02010402
205: C *** FCVS PROGRAM 402 - TEST 003 **** 02020402
206: C 02030402
207: C TEST 003 VERIFIES THAT THE A EDIT DESCRIPTOR (WITHOUT THE 02040402
208: C W OPTION) CAN PROPERLY EDIT SPECIAL CHARACTERS ON OUTPUT. THE 02050402
209: C SPECIAL CHARACTER / (SLASH) IS USED FOR THIS TEST AND IS STORED 02060402
210: C IN AN OUTPUT LIST ITEM 1 POSITION IN LENGTH. 02070402
211: C 02080402
212: IVTNUM = 003 02090402
213: IF (ICZERO) 30030, 0030, 30030 02100402
214: 0030 CONTINUE 02110402
215: CVTN11 = '/' 02120402
216: 0032 FORMAT (1H ,4X,I5,26X,A,14X,1H/) 02130402
217: WRITE (I02, 0032) IVTNUM, CVTN11 02140402
218: GO TO 0041 02150402
219: 30030 IVDELE = IVDELE + 1 02160402
220: WRITE (I02, 80000) IVTNUM 02170402
221: 0041 CONTINUE 02180402
222: C 02190402
223: C *** FCVS PROGRAM 402 - TEST 004 *** 02200402
224: C 02210402
225: C TEST 004 IS SIMILAR TO TEST 003 EXCEPT THAT THE DATA BEING 02220402
226: C EDITED IS NUMERIC. 02230402
227: C 02240402
228: IVTNUM = 004 02250402
229: IF (ICZERO) 30040, 0040, 30040 02260402
230: 0040 CONTINUE 02270402
231: CVTN11 = '9' 02280402
232: 0042 FORMAT (1H ,4X,I5,26X,A,14X,1H9) 02290402
233: WRITE (I02, 0042) IVTNUM, CVTN11 02300402
234: GO TO 0051 02310402
235: 30040 IVDELE = IVDELE + 1 02320402
236: WRITE (I02, 80000) IVTNUM 02330402
237: 0051 CONTINUE 02340402
238: C 02350402
239: C *** FCVS PROGRAM 402 - TEST 005 *** 02360402
240: C 02370402
241: C TEST 005 IS SIMILAR TO TEST 003 EXCEPT THAT IT USES THE SPECIAL02380402
242: C CHARACTER QUOTE. 02390402
243: C 02400402
244: IVTNUM = 005 02410402
245: IF (ICZERO) 30050, 0050, 30050 02420402
246: 0050 CONTINUE 02430402
247: CVTN11 = '''' 02440402
248: 0052 FORMAT (1H ,4X,I5,26X,A,14X,1H') 02450402
249: WRITE (I02, 0052) IVTNUM, CVTN11 02460402
250: GO TO 0061 02470402
251: 30050 IVDELE = IVDELE + 1 02480402
252: WRITE (I02, 80000) IVTNUM 02490402
253: C 02500402
254: C 02510402
255: C TESTS 006 THROUGH TEST 011 TESTS THE A EDIT DESCRIPTOR 02520402
256: C WITHOUT THE FIELD WIDTH SPECIFICATION (W OPTION) WHERE THE SIZE 02530402
257: C OF THE OUTPUT DATA ITEM IS 05 CHARACTERS IN LENGTH. 02540402
258: C 02550402
259: C 02560402
260: 0061 CONTINUE 02570402
261: C 02580402
262: C **** FCVS PROGRAM 402 - TEST 006 **** 02590402
263: C 02600402
264: C TEST 006 TESTS USE OF THE A EDIT DESCRIPTOR WITH LETTERS 02610402
265: C 02620402
266: IVTNUM = 006 02630402
267: IF (ICZERO) 30060, 0060, 30060 02640402
268: 0060 CONTINUE 02650402
269: CATN12(1) = 'ABMYZ' 02660402
270: 0062 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H ABMYZ) 02670402
271: WRITE (I02, 0062) IVTNUM, CATN12(1) 02680402
272: GO TO 0071 02690402
273: 30060 IVDELE = IVDELE + 1 02700402
274: WRITE (I02, 80000) IVTNUM 02710402
275: 0071 CONTINUE 02720402
276: C 02730402
277: C **** FCVS PROGRAM 402 - TEST 007 **** 02740402
278: C 02750402
279: C TEST 007 TESTS USE OF THE A EDIT DESCRIPTOR WITH DIGITS 02760402
280: C 02770402
281: IVTNUM = 007 02780402
282: IF (ICZERO) 30070, 0070, 30070 02790402
283: 0070 CONTINUE 02800402
284: CATN12(2) = '01589' 02810402
285: 0072 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H 01589) 02820402
286: WRITE (I02, 0072) IVTNUM, CATN12(2) 02830402
287: GO TO 0081 02840402
288: 30070 IVDELE = IVDELE + 1 02850402
289: WRITE (I02, 80000) IVTNUM 02860402
290: 0081 CONTINUE 02870402
291: C 02880402
292: C **** FCVS PROGRAM 402 - TEST 008 **** 02890402
293: C 02900402
294: C TEST 008 TESTS USE OF THE A EDIT DESCRIPTOR WITH SPECIAL 02910402
295: C CHARACTERS. 02920402
296: C 02930402
297: IVTNUM = 008 02940402
298: IF (ICZERO) 30080, 0080, 30080 02950402
299: 0080 CONTINUE 02960402
300: CATN12(3) = '=+-()' 02970402
301: 0082 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H =+-()) 02980402
302: WRITE (I02, 0082) IVTNUM, CATN12(3) 02990402
303: GO TO 0091 03000402
304: 30080 IVDELE = IVDELE + 1 03010402
305: WRITE (I02, 80000) IVTNUM 03020402
306: 0091 CONTINUE 03030402
307: C 03040402
308: C **** FCVS PROGRAM FM402 - TEST 009 **** 03050402
309: C 03060402
310: C TEST 009 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX 03070402
311: C OF LETTERS, DIGITS AND SPECIAL CHARACTERS 03080402
312: C 03090402
313: IVTNUM = 009 03100402
314: IF (ICZERO) 30090, 0090, 30090 03110402
315: 0090 CONTINUE 03120402
316: CATN12(4) = 'A5+.Z' 03130402
317: 0092 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H A5+.Z) 03140402
318: WRITE (I02, 0092) IVTNUM, CATN12(4) 03150402
319: GO TO 0101 03160402
320: 30090 IVDELE = IVDELE + 1 03170402
321: WRITE (I02, 80000) IVTNUM 03180402
322: 0101 CONTINUE 03190402
323: C 03200402
324: C **** FCVS PROGRAM FM402 - TEST 010 **** 03210402
325: C 03220402
326: C TEST 010 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX 03230402
327: C OF LETTERS, DIGITS AND SPECIAL CHARACTERS INCLUDING APOSTROPES 03240402
328: C 03250402
329: IVTNUM = 010 03260402
330: IF (ICZERO) 30100, 0100, 30100 03270402
331: 0100 CONTINUE 03280402
332: CATN12(5) = '1''A,4' 03290402
333: 0102 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H 1'A,4) 03300402
334: WRITE (I02, 0102) IVTNUM, CATN12(5) 03310402
335: GO TO 0111 03320402
336: 30100 IVDELE = IVDELE + 1 03330402
337: WRITE (I02, 80000) IVTNUM 03340402
338: C 03350402
339: 0111 CONTINUE 03360402
340: C **** FCVS PROGRAM FM402 - TEST 11 **** 03370402
341: C 03380402
342: C TEST 011 USES THE A EDIT DESCRIPTOR (WITHOUT THE OPTIONAL 03390402
343: C FIELD WIDTH SPECIFIED) WITH THE OPTIONAL REPEAT SPECIFICATION. 03400402
344: C EACH OUTPUT LIST ITEM WILL BE ONE CHARACTER IN LENGTH. 03410402
345: C 03420402
346: IVTNUM = 011 03430402
347: IF (ICZERO) 30110, 0110, 30110 03440402
348: 0110 CONTINUE 03450402
349: 0112 FORMAT (1H ,4X,I5,17X,10A,5X,10H059=+PQUVY) 03460402
350: WRITE (I02, 0112) IVTNUM, CATN11(1), CATN11(6), CATN11(10), 03470402
351: 1CATN11(11), CATN11(12), CATN11(36), CATN11(37), CATN11(41), 03480402
352: 2CATN11(42), CATN11(45) 03490402
353: GO TO 0121 03500402
354: 30110 IVDELE = IVDELE + 1 03510402
355: WRITE (I02, 80000) IVTNUM 03520402
356: 0121 CONTINUE 03530402
357: C 03540402
358: C **** FCVS PROGRAM FM402 - TEST 12 **** 03550402
359: C 03560402
360: C TEST 012 IS SIMILAR TO 011 IN THAT THE A DESCRIPTOR IS USED 03570402
361: C WITH THE OPTIONAL REPEAT SPECIFICATION E. G., 3A HOWEVER, EACH 03580402
362: C OUTPUT LIST ITEM HAS A DIFFERENT NUMBER OF CHARACTERS IN THE ITEM 03590402
363: C E. G., THE FIRST I/O LIST ITEM HAS 5 CHARACTERS, THE SECOND 03600402
364: C ITEM HAS 2 CHARACTERS AND THE THIRD ITEM HAS 1 CHARACTER. 03610402
365: C 03620402
366: IVTNUM = 012 03630402
367: IF (ICZERO) 30120, 0120, 30120 03640402
368: 0120 CONTINUE 03650402
369: CVTN13 = 'YZ' 03660402
370: CVTN11 = ')' 03670402
371: CATN12(2) = '(12AB' 03680402
372: 0122 FORMAT (1H ,4X,I5,17X,1H*,3A,1H*,5X,10H*(12ABYZ)*) 03690402
373: WRITE (I02, 0122) IVTNUM, CATN12(2), CVTN13, CVTN11 03700402
374: GO TO 0131 03710402
375: 30120 IVDELE = IVDELE + 1 03720402
376: WRITE (I02, 80000) IVTNUM 03730402
377: 0131 CONTINUE 03740402
378: C 03750402
379: C **** FCVS PROGRAM FM402 - TEST 13 *** 03760402
380: C 03770402
381: C TEST 013 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 03780402
382: C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM 03790402
383: C HAS FEWER CHARACTERS THAN SPECIFIED BY THE EDIT DESCRIPTOR. THE 03800402
384: C OUTPUT FIELD SHOULD CONSISTS OF BLANKS FOLLOWED BY CHARACTERS 03810402
385: C FROM THE INTERNAL REPRESENTATION. 03820402
386: C 03830402
387: IVTNUM = 013 03840402
388: IF (ICZERO) 30130, 0130, 30130 03850402
389: 0130 CONTINUE 03860402
390: CATN12(1) = 'ABMYZ' 03870402
391: 0132 FORMAT (1H ,4X,I5,17X,A10,5X,10H ABMYZ) 03880402
392: WRITE (I02, 0132) IVTNUM, CATN12(1) 03890402
393: GO TO 0141 03900402
394: 30130 IVDELE = IVDELE + 1 03910402
395: WRITE (I02, 80000) IVTNUM 03920402
396: 0141 CONTINUE 03930402
397: C 03940402
398: C **** FCVS PROGRAM FM402 - TEST 14 **** 03950402
399: C 03960402
400: C TEST 014 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 03970402
401: C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM 03980402
402: C IS GREATER THAN THAT SPECIFIED BY THE EDIT DESCRIPTOR. THE OUTPUT03990402
403: C FIELD SHOULD CONSIST OF THE LEFTMOST CHARACTERS FROM THE INTERNAL 04000402
404: C REPRESENTATION. 04010402
405: C 04020402
406: IVTNUM = 014 04030402
407: IF (ICZERO) 30140, 0140, 30140 04040402
408: 0140 CONTINUE 04050402
409: CVTN12 = '12345ABCDE' 04060402
410: 0142 FORMAT (1H ,4X,I5,17X,5H ,A5,5X,10H 12345) 04070402
411: WRITE (I02, 0142) IVTNUM, CVTN12 04080402
412: GO TO 0151 04090402
413: 30140 IVDELE = IVDELE + 1 04100402
414: WRITE (I02, 80000) IVTNUM 04110402
415: 0151 CONTINUE 04120402
416: C 04130402
417: C THE FOLLOWING BLOCK OF SOURCE CODE BEGINNING WITH COMMENT LINE 04140402
418: C **** CREATE-FILE SECTION AND ENDING WITH THE COMMENT LINE 04150402
419: C **** END-OF-CREATE-FILE SECTION BUILDS A FILE WHICH IS USED IN 04160402
420: C TESTING THE A EDIT DESCRIPTOR. THE FILE PROPERTIES ARE: 04170402
421: C 04180402
422: C FILE IDENTIFIER - I09 (X-NUMBER 09) 04190402
423: C RECORD SIZE - 80 CHARACTERS 04200402
424: C ACCESS METHOD - SEQUENTIAL 04210402
425: C RECORD TYPE - FORMATTED 04220402
426: C DESIGNATED DEVICE - DISK 04230402
427: C TYPE OF DATA - CHARACTER (A FORMAT) 04240402
428: C RECORDS IN FILE - 143 PLUS THE ENDFILE RECORD 04250402
429: C 04260402
430: C THE FIRST 20 POSITIONS OF EACH RECORD IN THE FILE UNIQUELY 04270402
431: C IDENTIFIES THAT RECORD. THE REMAINING POSITONS OF THE RECORD 04280402
432: C CONTAIN DATA WHICH IS USED IN TESTING THE A EDIT DESCRIPTOR. 04290402
433: C A DESCRIPTION OF EACH FIELD OF THE 20-CHARACTER PREAMBLE FOLLOWS. 04300402
434: C 04310402
435: C VARIABLE NAME IN PROGRAM CHARACTER POSITIONS 04320402
436: C -------- ---- -- ------- --------- --------- 04330402
437: C 04340402
438: C IPROG (ROUTINE NAME) - 1 THRU 3 04350402
439: C IFILE (LOGICAL/ X-NUMBER) - 4 THRU 5 04360402
440: C ITOTR (RECORDS IN FILE) - 6 THRU 9 04370402
441: C IRLGN (CHARACTERS IN RECORD) - 10 THRU 12 04380402
442: C IRECN (RECORD NUMBER) - 13 THRU 16 04390402
443: C IEOF (9999 IF LAST RECORD) - 17 THRU 20 04400402
444: C 04410402
445: C DEFAULT ASSIGNMENT FOR FILE IS I09 = 07 04420402
446: I09 = 07 04430402
447: OPEN(UNIT=I09,ACCESS='SEQUENTIAL',FORM='FORMATTED') 04440402
448: CX091 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-091 04450402
449: IPROG = 402 04460402
450: IFILE = I09 04470402
451: ITOTR = 143 04480402
452: IRLGN = 80 04490402
453: IRECN = 0 04500402
454: IEOF = 0 04510402
455: C 04520402
456: C 04530402
457: C ***** CREATE-FILE SECTION ***** 04540402
458: C 04550402
459: C 04560402
460: C **** FCVS PROGRAM 402 - TEST 015 **** 04570402
461: C 04580402
462: C 04590402
463: C TEST 15 WRITES RECORDS USING THE A EDIT DESCRIPTOR WITHOUT THE04600402
464: C OPTIONAL FIELD WIDTH SPECIFICATION. EACH CHARACTER OF THE 04610402
465: C FORTRAN SET IS WRITTEN WITH AN A EDIT DESCRIPTOR FROM 04620402
466: C THE INTERNAL REPRESENTATION WHICH IS ONE CHARACTER IN LENGTH. 04630402
467: C TEN DIFFERENT CHARACTERS ARE WRITTEN IN EACH RECORD UNTIL THE 04640402
468: C FULL CHARACTER SET IS EXHAUSTED. THIS SEQUENCE IS REPEATED UNTIL04650402
469: C 50 RECORDS HAVE BEEN WRITTEN (5 RECORDS PER SET AND 10 SETS). 04660402
470: C THE RECORDS ARE WRITTEN TO A MASS STORAGE FILE. 04670402
471: C 04680402
472: C 04690402
473: IVTNUM = 15 04700402
474: IF (ICZERO) 30150, 0150, 30150 04710402
475: 0150 CONTINUE 04720402
476: 70003 FORMAT (I3,I2,I4,I3,2I4,50X,10A) 04730402
477: 70004 FORMAT (I3,I2,I4,I3,2I4,54X,6A) 04740402
478: IRECN = 0 04750402
479: DO 4023 I=1,10 04760402
480: IRECN = IRECN + 1 04770402
481: WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04780402
482: 1 (CATN11 (J), J = 1,10) 04790402
483: C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD 04800402
484: IRECN = IRECN + 1 04810402
485: WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04820402
486: 1 (CATN11(J), J = 11,20) 04830402
487: C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD. 04840402
488: IRECN = IRECN + 1 04850402
489: WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04860402
490: 1 (CATN11(J), J = 21,30) 04870402
491: C CHARACTERS A THROUGH J ARE IN THIS RECORD 04880402
492: IRECN = IRECN + 1 04890402
493: WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04900402
494: 1 (CATN11(J), J = 31,40) 04910402
495: C CHARACTERS K THROUGH T ARE IN THIS RECORD 04920402
496: IRECN = IRECN + 1 04930402
497: WRITE (I09, 70004) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04940402
498: 1 (CATN11(J), J = 41,46) 04950402
499: C CHARACTERS U THROUGH Z ARE IN THIS RECORD 04960402
500: 4023 CONTINUE 04970402
501: IVCOMP = IRECN 04980402
502: IVCORR = 050 04990402
503: IVON01 = 50 05000402
504: 40150 IF (IVON01 - IRECN ) 20150, 10150, 20150 05010402
505: C VALUE IN IVCOMP IS THE NUMBER OF RECORDS WRITTEN 05020402
506: 30150 IVDELE = IVDELE + 1 05030402
507: WRITE (I02,80000) IVTNUM 05040402
508: IF (ICZERO) 10150, 0161, 20150 05050402
509: 10150 IVPASS = IVPASS + 1 05060402
510: WRITE (I02,80002) IVTNUM 05070402
511: GO TO 0161 05080402
512: 20150 IVFAIL = IVFAIL + 1 05090402
513: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05100402
514: 0161 CONTINUE 05110402
515: C 05120402
516: C **** FCVS PROGRAM 402 - TEST 016 **** 05130402
517: C 05140402
518: C 05150402
519: C TEST 16 IS THE SAME AS TEST 15 EXCEPT THAT THE 50 RECORDS 05160402
520: C WRITTEN USE THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH05170402
521: C SPECIFIED. 05180402
522: C 05190402
523: C 05200402
524: IVTNUM = 16 05210402
525: IF (ICZERO) 30160, 0160, 30160 05220402
526: 0160 CONTINUE 05230402
527: 70005 FORMAT (I3,I2,I4,I3,2I4,50X,10A1) 05240402
528: 70006 FORMAT (I3,I2,I4,I3,2I4,54X,6A1) 05250402
529: IRECN = 50 05260402
530: DO 4024 I=1,10 05270402
531: IRECN = IRECN + 1 05280402
532: WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05290402
533: 1 (CATN11(J), J = 1,10) 05300402
534: C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD 05310402
535: IRECN = IRECN + 1 05320402
536: WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05330402
537: 1 (CATN11(J), J = 11,20) 05340402
538: C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD 05350402
539: IRECN = IRECN + 1 05360402
540: WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05370402
541: 1 (CATN11(J), J = 21,30) 05380402
542: C CHARACTERS A THROUGH J ARE IN THIS RECORD 05390402
543: IRECN = IRECN + 1 05400402
544: WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05410402
545: 1 (CATN11(J), J = 31,40) 05420402
546: C CHARACTERS K THROUGH T ARE IN THIS RECORD 05430402
547: IRECN = IRECN + 1 05440402
548: WRITE (I09, 70006) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05450402
549: 1 (CATN11(J), J = 41,46) 05460402
550: C CHARACTERS U THROUGH Z ARE IN THIS RECORD 05470402
551: 4024 CONTINUE 05480402
552: IVCOMP = IRECN - 50 05490402
553: IVCORR = 50 05500402
554: IVON01 = 100 05510402
555: 40160 IF (IVON01 - IRECN) 20160, 10160, 20160 05520402
556: 30160 IVDELE = IVDELE + 1 05530402
557: WRITE (I02,80000) IVTNUM 05540402
558: IF (ICZERO) 10160, 0171, 20160 05550402
559: 10160 IVPASS = IVPASS + 1 05560402
560: WRITE (I02,80002) IVTNUM 05570402
561: GO TO 0171 05580402
562: 20160 IVFAIL = IVFAIL + 1 05590402
563: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05600402
564: 0171 CONTINUE 05610402
565: C 05620402
566: C **** FCVS PROGRAM 402 - TEST 017 **** 05630402
567: C 05640402
568: C 05650402
569: C TEST 17 WRITES 40 RECORDS CONTAINING CHARACTER DATA WHICH IS 05660402
570: C USED FOR LATER TESTS. THE FILE SHOULD CONTAIN 140 RECORDS 05670402
571: C FOLLOWING EXECUTION OF THIS TEST. 05680402
572: C 05690402
573: C 05700402
574: IVTNUM = 17 05710402
575: IF (ICZERO) 30170, 0170, 30170 05720402
576: 0170 CONTINUE 05730402
577: 70007 FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 05740402
578: 1 ) 05750402
579: 70008 FORMAT (I3,I2,I4,I3,2I4,60H=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4 05760402
580: 1 ) 05770402
581: IRECN = 100 05780402
582: DO 4025 I = 1,20 05790402
583: IRECN = IRECN + 1 05800402
584: WRITE (I09, 70007) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 05810402
585: C CHARACTERS 0 THROUGH 9 AND A THROUGH Z ARE IN THIS RECORD 05820402
586: IRECN = IRECN + 1 05830402
587: WRITE (I09, 70008) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 05840402
588: C SPECIAL CHARACTERS ARE IN THIS RECORD 05850402
589: 4025 CONTINUE 05860402
590: IVCOMP = IRECN - 100 05870402
591: IVCORR = 40 05880402
592: IVON01 = 140 05890402
593: 40170 IF (IVON01 - IRECN) 20170, 10170, 20170 05900402
594: 30170 IVDELE = IVDELE + 1 05910402
595: WRITE (I02,80000) IVTNUM 05920402
596: IF (ICZERO) 10170, 0181, 20170 05930402
597: 10170 IVPASS = IVPASS + 1 05940402
598: WRITE (I02,80002) IVTNUM 05950402
599: GO TO 0181 05960402
600: 20170 IVFAIL = IVFAIL + 1 05970402
601: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05980402
602: 0181 CONTINUE 05990402
603: C 06000402
604: C **** FCVS PROGRAM 402 - TEST 018 **** 06010402
605: C 06020402
606: C 06030402
607: C TEST 18 WRITES A RECORD WHICH CONTAINS A LONG FIELD (50 CHAR- 06040402
608: C ACTERS) USING AN A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD 06050402
609: C WIDTH SPECIFICATION. 06060402
610: C 06070402
611: C 06080402
612: IVTNUM = 18 06090402
613: IF (ICZERO) 30180, 0180, 30180 06100402
614: 0180 CONTINUE 06110402
615: IRECN = 141 06120402
616: 70009 FORMAT (I3,I2,I4,I3,2I4,10X,A) 06130402
617: WRITE (I09, 70009) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN1506140402
618: IVCOMP = IRECN - 140 06150402
619: IVCORR = 1 06160402
620: IVON01 = 141 06170402
621: 40180 IF (IVON01 - IRECN) 20180, 10180, 20180 06180402
622: 30180 IVDELE = IVDELE + 1 06190402
623: WRITE (I02,80000) IVTNUM 06200402
624: IF (ICZERO) 10180, 0191, 20180 06210402
625: 10180 IVPASS = IVPASS + 1 06220402
626: WRITE (I02,80002) IVTNUM 06230402
627: GO TO 0191 06240402
628: 20180 IVFAIL = IVFAIL + 1 06250402
629: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06260402
630: 0191 CONTINUE 06270402
631: C 06280402
632: C **** FCVS PROGRAM 402 - TEST 019 **** 06290402
633: C 06300402
634: C 06310402
635: C TEST 19 WRITES A LONG FIELD (50 CHARACTERS) 06320402
636: C USING AN A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH 06330402
637: C SPECIFICATION. 06340402
638: C 06350402
639: C 06360402
640: IVTNUM = 19 06370402
641: IF (ICZERO) 30190, 0190, 30190 06380402
642: 0190 CONTINUE 06390402
643: IRECN = 142 06400402
644: 70010 FORMAT (I3,I2,I4,I3,2I4,10X,A50) 06410402
645: WRITE (I09, 70010) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN1506420402
646: IVCOMP = IRECN - 141 06430402
647: IVCORR = 1 06440402
648: IVON01 = 142 06450402
649: 40190 IF (IVON01 - IRECN) 20190, 10190, 20190 06460402
650: 30190 IVDELE = IVDELE + 1 06470402
651: WRITE (I02,80000) IVTNUM 06480402
652: IF (ICZERO) 10190, 0201, 20190 06490402
653: 10190 IVPASS = IVPASS + 1 06500402
654: WRITE (I02,80002) IVTNUM 06510402
655: GO TO 0201 06520402
656: 20190 IVFAIL = IVFAIL + 1 06530402
657: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06540402
658: 0201 CONTINUE 06550402
659: C 06560402
660: C **** FCVS PROGRAM 402 - TEST 020 **** 06570402
661: C 06580402
662: C 06590402
663: IVTNUM = 20 06600402
664: IF (ICZERO) 30200, 0200, 30200 06610402
665: 0200 CONTINUE 06620402
666: IRECN = IRECN + 1 06630402
667: IEOF = 9999 06640402
668: 70011 FORMAT (I3,I2,I4,I3,2I4,59X,1H ) 06650402
669: WRITE (I09, 70011) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 06660402
670: ENDFILE I09 06670402
671: REWIND I09 06680402
672: WRITE (I02, 90004) 06690402
673: 70012 FORMAT (53H FILE I09 HAS BEEN CREATED AND CONTAINS 143 RECORDS) 06700402
674: 70013 FORMAT (39H INCORRECT NUMBER OF RECORDS IN FILE - , I5 ,08H RECO06710402
675: 1RDS) 06720402
676: 70014 FORMAT (50H WRITTEN BUT 143 RECORDS SHOULD HAVE BEEN WRITTEN.) 06730402
677: IF (IRECN - 143) 4020, 4021, 4020 06740402
678: 4020 WRITE (I02, 70013) IRECN 06750402
679: WRITE (I02, 70014) 06760402
680: GO TO 4022 06770402
681: 4021 WRITE (I02, 70012) 06780402
682: WRITE (I02, 90004) 06790402
683: C 06800402
684: C **** END-OF-CREATE-FILE SECTION **** 06810402
685: C 06820402
686: 4022 CONTINUE 06830402
687: C 06840402
688: C TESTS 20 THROUGH 24 READ 5 OF THE FIRST 50 RECORDS USING THE 06850402
689: C A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD WIDTH SPECIFICATION. 06860402
690: C EACH CHARACTER IS CHECKED FOR PROPER EDITING. THE FIELDS ARE 06870402
691: C WRITTEN AND READ WITH THE SAME A EDIT DESCRIPTOR FORM. THE 06880402
692: C RESULTING NUMBER FROM EACH TEST IN IVCOMP AND IVCORR IS 06890402
693: C THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ. 06900402
694: C 06910402
695: C 06920402
696: C TEST 20 READS AND CHECKS THE CHARACTERS 0 THROUGH 9. THE 06930402
697: C VALUE RESULTING FROM THE TEST IN IVCOMP AND IVCORR REFLECTS THE 06940402
698: C NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ. 06950402
699: C 06960402
700: IVCOMP = 0 06970402
701: IVCORR = 10 06980402
702: 0202 FORMAT (70X,10A) 06990402
703: READ (I09, 0202) (CATN14(J), J = 1,10) 07000402
704: DO 0203 I=1,10 07010402
705: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07020402
706: 0203 CONTINUE 07030402
707: 40200 IF (IVCOMP - 10) 20200, 10200, 20200 07040402
708: 30200 IVDELE = IVDELE + 1 07050402
709: WRITE (I02,80000) IVTNUM 07060402
710: IF (ICZERO) 10200, 0211, 20200 07070402
711: 10200 IVPASS = IVPASS + 1 07080402
712: WRITE (I02,80002) IVTNUM 07090402
713: GO TO 0211 07100402
714: 20200 IVFAIL = IVFAIL + 1 07110402
715: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07120402
716: 0211 CONTINUE 07130402
717: C 07140402
718: C **** FCVS PROGRAM 402 - TEST 021 **** 07150402
719: C 07160402
720: C 07170402
721: C TEST 21 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND07180402
722: C '. THE NUMBER RESULTING FROM THE TEST IN IVCOMP AND IVCORR 07190402
723: C REFLECTS THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF 07200402
724: C THE READ. 07210402
725: C 07220402
726: C 07230402
727: IVTNUM = 21 07240402
728: IF (ICZERO) 30210, 0210, 30210 07250402
729: 0210 CONTINUE 07260402
730: IVCOMP = 0 07270402
731: IVCORR = 10 07280402
732: 0212 FORMAT (70X,10A) 07290402
733: READ (I09, 0212) (CATN14(J), J = 11,20) 07300402
734: DO 0213 I = 11,20 07310402
735: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07320402
736: 0213 CONTINUE 07330402
737: 40210 IF (IVCOMP - 10) 20210, 10210, 20210 07340402
738: 30210 IVDELE = IVDELE + 1 07350402
739: WRITE (I02,80000) IVTNUM 07360402
740: IF (ICZERO) 10210, 0221, 20210 07370402
741: 10210 IVPASS = IVPASS + 1 07380402
742: WRITE (I02,80002) IVTNUM 07390402
743: GO TO 0221 07400402
744: 20210 IVFAIL = IVFAIL + 1 07410402
745: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07420402
746: 0221 CONTINUE 07430402
747: C 07440402
748: C **** FCVS PROGRAM 402 - TEST 022 **** 07450402
749: C 07460402
750: C 07470402
751: C TEST 22 READS AND CHECKS THE CHARACTERS A THROUGH J. 07480402
752: C 07490402
753: C 07500402
754: IVTNUM = 22 07510402
755: IF (ICZERO) 30220, 0220, 30220 07520402
756: 0220 CONTINUE 07530402
757: IVCOMP = 0 07540402
758: IVCORR = 10 07550402
759: 0222 FORMAT (70X,10A) 07560402
760: READ (I09, 0222) (CATN14(J), J = 21,30) 07570402
761: DO 0223 I = 21,30 07580402
762: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07590402
763: 0223 CONTINUE 07600402
764: 40220 IF (IVCOMP - 10) 20220, 10220, 20220 07610402
765: 30220 IVDELE = IVDELE + 1 07620402
766: WRITE (I02,80000) IVTNUM 07630402
767: IF (ICZERO) 10220, 0231, 20220 07640402
768: 10220 IVPASS = IVPASS + 1 07650402
769: WRITE (I02,80002) IVTNUM 07660402
770: GO TO 0231 07670402
771: 20220 IVFAIL = IVFAIL + 1 07680402
772: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07690402
773: 0231 CONTINUE 07700402
774: C 07710402
775: C **** FCVS PROGRAM 402 - TEST 023 **** 07720402
776: C 07730402
777: C 07740402
778: C TEST 23 READS AND CHECKS THE CHARACTERS K THROUGH T. 07750402
779: C 07760402
780: C 07770402
781: IVTNUM = 23 07780402
782: IF (ICZERO) 30230, 0230, 30230 07790402
783: 0230 CONTINUE 07800402
784: IVCOMP = 0 07810402
785: IVCORR = 10 07820402
786: 0232 FORMAT (70X,10A) 07830402
787: READ (I09, 0232) (CATN14(J), J = 31,40) 07840402
788: DO 0233 I = 31,40 07850402
789: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07860402
790: 0233 CONTINUE 07870402
791: 40230 IF (IVCOMP - 10) 20230, 10230, 20230 07880402
792: 30230 IVDELE = IVDELE + 1 07890402
793: WRITE (I02,80000) IVTNUM 07900402
794: IF (ICZERO) 10230, 0241, 20230 07910402
795: 10230 IVPASS = IVPASS + 1 07920402
796: WRITE (I02,80002) IVTNUM 07930402
797: GO TO 0241 07940402
798: 20230 IVFAIL = IVFAIL + 1 07950402
799: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07960402
800: 0241 CONTINUE 07970402
801: C 07980402
802: C **** FCVS PROGRAM 402 - TEST 024 **** 07990402
803: C 08000402
804: C 08010402
805: C TEST 24 READS AND CHECKS THE CHARACTERS U THROUGH Z. 08020402
806: C 08030402
807: C 08040402
808: IVTNUM = 24 08050402
809: IF (ICZERO) 30240, 0240, 30240 08060402
810: 0240 CONTINUE 08070402
811: IVCOMP = 0 08080402
812: IVCORR = 06 08090402
813: 0242 FORMAT (74X,6A) 08100402
814: READ (I09, 0242) (CATN14(J), J = 41,46) 08110402
815: DO 0243 I = 41,46 08120402
816: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 08130402
817: 0243 CONTINUE 08140402
818: 40240 IF (IVCOMP - 6) 20240, 10240, 20240 08150402
819: 30240 IVDELE = IVDELE + 1 08160402
820: WRITE (I02,80000) IVTNUM 08170402
821: IF (ICZERO) 10240, 0251, 20240 08180402
822: 10240 IVPASS = IVPASS + 1 08190402
823: WRITE (I02,80002) IVTNUM 08200402
824: GO TO 0251 08210402
825: 20240 IVFAIL = IVFAIL + 1 08220402
826: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08230402
827: 0251 CONTINUE 08240402
828: C 08250402
829: C 08260402
830: C TESTS 25 THROUGH 29 READ RECORD NUMBERS 56 THROUGH 60 USING 08270402
831: C THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH SPECIFIED. 08280402
832: C EACH FIELD IS 1 CHARACTER IN LENGTH AND IS CHECKED FOR PROPER 08290402
833: C EDITING. THE FIELDS ARE WRITTEN AND READ WITH THE SAME EDIT 08300402
834: C DESCRIPTOR. THE NUMBER RESULTING FROM EACH TEST IN IVCOMP AND 08310402
835: C IVCORR IS THE THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT 08320402
836: C OF THE READ. 08330402
837: C 08340402
838: C 08350402
839: 70020 FORMAT (12X,2I4,59X,A1) 08360402
840: REWIND I09 08370402
841: DO 4026 I = 1, 150 08380402
842: READ (I09, 70020, END = 4027) IRECN, IEOF 08390402
843: IF (IRECN .EQ. 55) GO TO 4027 08400402
844: 4026 CONTINUE 08410402
845: 4027 IF (IRECN - 55) 4028, 4029, 4028 08420402
846: C 08430402
847: C THE CODE IMMEDIATELY PRECEDING POSITIONS THE FILE TO RECORD 08440402
848: C NUMBER 55 FOR TESTS 25 THROUGH 29. 08450402
849: C 08460402
850: 70021 FORMAT (64H THE INITIAL RECORD FOR TESTS 25 THROUGH 29 COULD NOT 08470402
851: 1BE FOUND,) 08480402
852: 70022 FORMAT (49H THEREFORE TESTS 25 THROUGH 29 ARE DELETED.) 08490402
853: 4028 WRITE (I02, 70021) 08500402
854: WRITE (I02, 70022) 08510402
855: GO TO 301 08520402
856: 4029 CONTINUE 08530402
857: DO 4030 I = 1,46 08540402
858: CATN14(I) = ' ' 08550402
859: 4030 CONTINUE 08560402
860: C 08570402
861: C THE ABOVE DO LOOP INITIALIZES THE ARRAY CATN14 TO BLANKS. 08580402
862: C 08590402
863: C 08600402
864: C **** FCVS PROGRAM 402 - TEST 025 **** 08610402
865: C 08620402
866: C 08630402
867: C TEST 25 READS AND CHECKS THE CHARACTERS 0 THROUGH 9. 08640402
868: C 08650402
869: C 08660402
870: IVTNUM = 25 08670402
871: IF (ICZERO) 30250, 0250, 30250 08680402
872: 0250 CONTINUE 08690402
873: IVCOMP = 0 08700402
874: IVCORR = 10 08710402
875: 0252 FORMAT (70X,10A1) 08720402
876: READ (I09, 0252) (CATN14(J), J = 1, 10) 08730402
877: DO 0253 I = 1,10 08740402
878: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 08750402
879: 0253 CONTINUE 08760402
880: 40250 IF (IVCOMP - 10) 20250, 10250, 20250 08770402
881: 30250 IVDELE = IVDELE + 1 08780402
882: WRITE (I02,80000) IVTNUM 08790402
883: IF (ICZERO) 10250, 0261, 20250 08800402
884: 10250 IVPASS = IVPASS + 1 08810402
885: WRITE (I02,80002) IVTNUM 08820402
886: GO TO 0261 08830402
887: 20250 IVFAIL = IVFAIL + 1 08840402
888: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08850402
889: 0261 CONTINUE 08860402
890: C 08870402
891: C **** FCVS PROGRAM 402 - TEST 026 **** 08880402
892: C 08890402
893: C 08900402
894: C TEST 26 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND08910402
895: C '. 08920402
896: C 08930402
897: C 08940402
898: IVTNUM = 26 08950402
899: IF (ICZERO) 30260, 0260, 30260 08960402
900: 0260 CONTINUE 08970402
901: IVCOMP = 0 08980402
902: IVCORR = 10 08990402
903: 0262 FORMAT (70X,10A1) 09000402
904: READ (I09, 0262) (CATN14(J), J = 11, 20) 09010402
905: DO 0263 I = 11,20 09020402
906: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09030402
907: 0263 CONTINUE 09040402
908: 40260 IF (IVCOMP -10) 20260, 10260, 20260 09050402
909: 30260 IVDELE = IVDELE + 1 09060402
910: WRITE (I02,80000) IVTNUM 09070402
911: IF (ICZERO) 10260, 0271, 20260 09080402
912: 10260 IVPASS = IVPASS + 1 09090402
913: WRITE (I02,80002) IVTNUM 09100402
914: GO TO 0271 09110402
915: 20260 IVFAIL = IVFAIL + 1 09120402
916: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09130402
917: 0271 CONTINUE 09140402
918: C 09150402
919: C **** FCVS PROGRAM 402 - TEST 027 **** 09160402
920: C 09170402
921: C 09180402
922: C TEST 27 READS AND CHECKS THE CHARACTERS A THROUGH J. 09190402
923: C 09200402
924: C 09210402
925: IVTNUM = 27 09220402
926: IF (ICZERO) 30270, 0270, 30270 09230402
927: 0270 CONTINUE 09240402
928: IVCOMP = 0 09250402
929: IVCORR = 10 09260402
930: 0272 FORMAT (70X,10A1) 09270402
931: READ (I09, 0272) (CATN14(J), J = 21,30) 09280402
932: DO 0273 I = 21,30 09290402
933: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09300402
934: 0273 CONTINUE 09310402
935: 40270 IF (IVCOMP - 10) 20270, 10270, 20270 09320402
936: 30270 IVDELE = IVDELE + 1 09330402
937: WRITE (I02,80000) IVTNUM 09340402
938: IF (ICZERO) 10270, 0281, 20270 09350402
939: 10270 IVPASS = IVPASS + 1 09360402
940: WRITE (I02,80002) IVTNUM 09370402
941: GO TO 0281 09380402
942: 20270 IVFAIL = IVFAIL + 1 09390402
943: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09400402
944: 0281 CONTINUE 09410402
945: C 09420402
946: C **** FCVS PROGRAM 402 - TEST 028 **** 09430402
947: C 09440402
948: C 09450402
949: C TEST 28 READS AND CHECKS THE CHARACTERS K THROUGH T. 09460402
950: C 09470402
951: C 09480402
952: IVTNUM = 28 09490402
953: IF (ICZERO) 30280, 0280, 30280 09500402
954: 0280 CONTINUE 09510402
955: IVCOMP = 0 09520402
956: IVCORR = 10 09530402
957: 0282 FORMAT (70X,10A1) 09540402
958: READ (I09, 0282) (CATN14(J), J = 31,40) 09550402
959: DO 0283 I = 31, 40 09560402
960: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09570402
961: 0283 CONTINUE 09580402
962: 40280 IF (IVCOMP - 10) 20280, 10280, 20280 09590402
963: 30280 IVDELE = IVDELE + 1 09600402
964: WRITE (I02,80000) IVTNUM 09610402
965: IF (ICZERO) 10280, 0291, 20280 09620402
966: 10280 IVPASS = IVPASS + 1 09630402
967: WRITE (I02,80002) IVTNUM 09640402
968: GO TO 0291 09650402
969: 20280 IVFAIL = IVFAIL + 1 09660402
970: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09670402
971: 0291 CONTINUE 09680402
972: C 09690402
973: C **** FCVS PROGRAM 402 - TEST 029 **** 09700402
974: C 09710402
975: C 09720402
976: C TEST 29 READS AND CHECKS THE CHARACTERS U THROUGH Z. 09730402
977: C 09740402
978: C 09750402
979: IVTNUM = 29 09760402
980: IF (ICZERO) 30290, 0290, 30290 09770402
981: 0290 CONTINUE 09780402
982: IVCOMP = 0 09790402
983: IVCORR = 6 09800402
984: 0292 FORMAT (74X,6A1) 09810402
985: READ (I09, 0292) (CATN14(J), J = 41,46) 09820402
986: DO 0293 I = 41,46 09830402
987: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09840402
988: 0293 CONTINUE 09850402
989: 40290 IF (IVCOMP - 6) 20290, 10290, 20290 09860402
990: 30290 IVDELE = IVDELE + 1 09870402
991: WRITE (I02,80000) IVTNUM 09880402
992: IF (ICZERO) 10290, 0301, 20290 09890402
993: 10290 IVPASS = IVPASS + 1 09900402
994: WRITE (I02,80002) IVTNUM 09910402
995: GO TO 0301 09920402
996: 20290 IVFAIL = IVFAIL + 1 09930402
997: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09940402
998: 0301 CONTINUE 09950402
999: C 09960402
1000: C 09970402
1001: C TESTS 30 THROUGH 32 READ RECORD NUMBERS 101 THROUGH 103. THESE09980402
1002: C TESTS TEST FOR PROPER EDITING ON INPUT WHERE THE INPUT FIELD 09990402
1003: C AND THE INPUT LIST ITEM ARE OF DIFFERENT SIZES. 10000402
1004: C 10010402
1005: C 10020402
1006: 70031 FORMAT (12X,2I4,59X,A1) 10030402
1007: REWIND I09 10040402
1008: DO 4031 I = 1,150 10050402
1009: READ (I09, 70031, END = 4032) IRECN, IEOF 10060402
1010: IF (IRECN .EQ. 100) GO TO 4032 10070402
1011: 4031 CONTINUE 10080402
1012: 4032 IF (IRECN - 100) 4033, 4034, 4033 10090402
1013: 70032 FORMAT (64H THE START RECORD FOR TESTS 30 THROUGH 32 COULD NOT 10100402
1014: 1BE FOUND,) 10110402
1015: 70033 FORMAT (49H THEREFORE TESTS 30 THROUGH 32 ARE DELETED.) 10120402
1016: 4033 WRITE (I02, 70032) 10130402
1017: WRITE (I02, 70033) 10140402
1018: GO TO 331 10150402
1019: 4034 CONTINUE 10160402
1020: C 10170402
1021: C **** FCVS PROGRAM 402 - TEST 030 **** 10180402
1022: C 10190402
1023: C 10200402
1024: C TEST 30 TESTS THE A EDIT DESCRIPTOR WITH THE OPTIONAL REPEAT 10210402
1025: C SPECIFICATION. THE A EDIT DESCRIPTOR DOES NOT HAVE THE OPTIONAL 10220402
1026: C FIELD WIDTH SPECIFICATION AND THE INPUT LIST ITEMS VARY IN SIZE 10230402
1027: C FROM 1 TO 10 CHARACTERS. RECORD NUMBER 101 IS READ AND WAS 10240402
1028: C CREATED IN TEST 17 WITH THE FORMAT STATEMENT 10250402
1029: C 10260402
1030: C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 10270402
1031: C 1 ) 10280402
1032: C 10290402
1033: C 10300402
1034: IVTNUM = 30 10310402
1035: IF (ICZERO) 30300, 0300, 30300 10320402
1036: 0300 CONTINUE 10330402
1037: IVCOMP = 1 10340402
1038: IVCORR = 210 10350402
1039: CATN14(1) = ' ' 10360402
1040: CVTN13 = ' ' 10370402
1041: CATN12(3) = ' ' 10380402
1042: CVTN12 = ' ' 10390402
1043: 0302 FORMAT (20X,4A,42X,A1) 10400402
1044: READ (I09, 0302, END = 0303) CATN14(1), CVTN13, CATN12(3), CVTN1210410402
1045: 0303 IF (CATN14(1) .EQ. 'A') IVCOMP = IVCOMP * 2 10420402
1046: IF (CVTN13 .EQ. 'BC') IVCOMP = IVCOMP * 3 10430402
1047: IF (CATN12(3) .EQ. 'DEFGH') IVCOMP = IVCOMP * 5 10440402
1048: IF (CVTN12 .EQ. 'IJKLMNOPQR') IVCOMP = IVCOMP * 7 10450402
1049: 40300 IF (IVCOMP - 210) 20300, 10300, 20300 10460402
1050: 30300 IVDELE = IVDELE + 1 10470402
1051: WRITE (I02,80000) IVTNUM 10480402
1052: IF (ICZERO) 10300, 0311, 20300 10490402
1053: 10300 IVPASS = IVPASS + 1 10500402
1054: WRITE (I02,80002) IVTNUM 10510402
1055: GO TO 0311 10520402
1056: 20300 IVFAIL = IVFAIL + 1 10530402
1057: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10540402
1058: 0311 CONTINUE 10550402
1059: C 10560402
1060: C **** FCVS PROGRAM 402 - TEST 031 **** 10570402
1061: C 10580402
1062: C 10590402
1063: C TEST 31 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR WHEN10600402
1064: C THE SPECIFIED WIDTH OF THE DESCRIPTOR IS LESS THAN THE INTERNAL 10610402
1065: C REPRESENTATION OF THE INPUT LIST ITEM. THE CHARACTERS SHOULD 10620402
1066: C APPEAR LEFT-JUSTIFIED WITH TRAILING BLANKS IN THE INTERNAL 10630402
1067: C REPRESENTATION. RECORD NUMBER 102 IS READ AND WAS CREATED 10640402
1068: C IN TEST 17 WITH THE FORMAT STATEMENT 10650402
1069: C 10660402
1070: C FORMAT (I3,I2,I4,I3,2I4,60H=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4 10670402
1071: C 1 ) 10680402
1072: C 10690402
1073: C 10700402
1074: C 10710402
1075: IVTNUM = 31 10720402
1076: IF (ICZERO) 30310, 0310, 30310 10730402
1077: 0310 CONTINUE 10740402
1078: CVTN12 = '9999999999' 10750402
1079: IVCOMP = 0 10760402
1080: IVCORR = 1 10770402
1081: 0312 FORMAT (20X,10X,A5,40X) 10780402
1082: READ (I09, 0312, END = 0313) CVTN12 10790402
1083: 0313 IF (CVTN12 .EQ. 'ABMYZ ') IVCOMP = 1 10800402
1084: 40310 IF (IVCOMP - 1) 20310, 10310, 20310 10810402
1085: 30310 IVDELE = IVDELE + 1 10820402
1086: WRITE (I02,80000) IVTNUM 10830402
1087: IF (ICZERO) 10310, 0321, 20310 10840402
1088: 10310 IVPASS = IVPASS + 1 10850402
1089: WRITE (I02,80002) IVTNUM 10860402
1090: GO TO 0321 10870402
1091: 20310 IVFAIL = IVFAIL + 1 10880402
1092: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10890402
1093: 0321 CONTINUE 10900402
1094: C 10910402
1095: C **** FCVS PROGRAM 402 - TEST 032 **** 10920402
1096: C 10930402
1097: C 10940402
1098: C TEST 32 TESTS FOR PROPER EDITING OF THE A EDIT 10950402
1099: C DESCRIPTOR WHEN THE WIDTH OF THE DESCRIPTOR IS GREATER THAN THE 10960402
1100: C INTERNAL REPRESENTATION OF THE INPUT LIST ITEM. THE RIGHTMOST 10970402
1101: C CHARACTERS SHOULD BE TAKEN FROM THE INPUT FIELD. RECORD NUMBER 10980402
1102: C 103 IS EXPECTED TO BE READ. THE RECORD WAS CREATED IN TEST 17 10990402
1103: C WITH THE FORMAT STATEMENT 11000402
1104: C 11010402
1105: C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 11020402
1106: C 1 ) 11030402
1107: C 11040402
1108: C 11050402
1109: C 11060402
1110: IVTNUM = 32 11070402
1111: IF (ICZERO) 30320, 0320, 30320 11080402
1112: 0320 CONTINUE 11090402
1113: CATN12 (5) = 'AAAAA' 11100402
1114: IVCOMP = 0 11110402
1115: IVCORR = 1 11120402
1116: 0322 FORMAT (20X,10X,A10,35X) 11130402
1117: READ (I09, 0322, END = 0323) CATN12 (5) 11140402
1118: 0323 IF (CATN12(5) .EQ. 'PQRST') IVCOMP = 1 11150402
1119: 40320 IF (IVCOMP - 1) 20320, 10320, 20320 11160402
1120: 30320 IVDELE = IVDELE + 1 11170402
1121: WRITE (I02,80000) IVTNUM 11180402
1122: IF (ICZERO) 10320, 0331, 20320 11190402
1123: 10320 IVPASS = IVPASS + 1 11200402
1124: WRITE (I02,80002) IVTNUM 11210402
1125: GO TO 0331 11220402
1126: 20320 IVFAIL = IVFAIL + 1 11230402
1127: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11240402
1128: 0331 CONTINUE 11250402
1129: C 11260402
1130: C 11270402
1131: C TESTS 33 AND 34 READ A LONG INPUT FIELD (50 CHARACTERS) AND 11280402
1132: C CHECK RESULTING INTERNAL REPRESENTATION. THE RECORD IS READ 11290402
1133: C WITH THE SAME A EDIT DESCRIPTOR AS WAS USED TO WRITE THE RECORD. 11300402
1134: C 11310402
1135: C 11320402
1136: 70034 FORMAT (12X,2I4,60X) 11330402
1137: REWIND I09 11340402
1138: DO 4035 I = 1,150 11350402
1139: READ (I09, 70034, END = 4036) IRECN, IEOF 11360402
1140: IF (IRECN .EQ. 140) GO TO 4036 11370402
1141: 4035 CONTINUE 11380402
1142: 4036 IF (IRECN - 140) 4037, 4038, 4037 11390402
1143: C THE ABOVE CODE POSITIONS THE FILE TO RECORD NUMBER 140 FOR 11400402
1144: C TESTS 33 AND 34. 11410402
1145: C 11420402
1146: 70035 FORMAT (61H THE START RECORD FOR TESTS 33 AND 34 COULD NOT BE 11430402
1147: 1FOUND,) 11440402
1148: 70036 FORMAT (45H THEREFORE TESTS 33 AND 34 ARE DELETED.) 11450402
1149: 4037 WRITE (I02, 70035) 11460402
1150: WRITE (I02, 70036) 11470402
1151: GO TO 351 11480402
1152: 4038 CONTINUE 11490402
1153: C 11500402
1154: C **** FCVS PROGRAM 402 - TEST 033 **** 11510402
1155: C 11520402
1156: C 11530402
1157: C TEST 33 READS A LONG FIELD WITH THE WIDTH SPECIFIED ON THE A 11540402
1158: C EDIT DESCRIPTOR. RECORD NUMBER 141 IS READ. THE RECORD WAS 11550402
1159: C CREATED IN TEST 18 AND CONTAINS FIELD DATA OF 11560402
1160: C 11570402
1161: C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789' 11580402
1162: C 11590402
1163: C WITHOUT THE SURROUNDING APOSTROPHES. 11600402
1164: C 11610402
1165: C 11620402
1166: C 11630402
1167: IVTNUM = 33 11640402
1168: IF (ICZERO) 30330, 0330, 30330 11650402
1169: 0330 CONTINUE 11660402
1170: CVTN15 = ' ' 11670402
1171: IVCOMP = 0 11680402
1172: IVCORR = 1 11690402
1173: 0332 FORMAT (20X,10X,A50) 11700402
1174: READ (I09, 0332) CVTN15 11710402
1175: IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 01234567811720402
1176: 19') IVCOMP = 1 11730402
1177: 40330 IF (IVCOMP -1 ) 20330, 10330, 20330 11740402
1178: 30330 IVDELE = IVDELE + 1 11750402
1179: WRITE (I02,80000) IVTNUM 11760402
1180: IF (ICZERO) 10330, 0341, 20330 11770402
1181: 10330 IVPASS = IVPASS + 1 11780402
1182: WRITE (I02,80002) IVTNUM 11790402
1183: GO TO 0341 11800402
1184: 20330 IVFAIL = IVFAIL + 1 11810402
1185: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11820402
1186: 0341 CONTINUE 11830402
1187: C 11840402
1188: C **** FCVS PROGRAM 402 - TEST 034 **** 11850402
1189: C 11860402
1190: C 11870402
1191: C TEST 34 READS A LONG FIELD USING THE A EDIT DESCRIPTOR 11880402
1192: C WITHOUT THE OPTIONAL WIDTH SPECIFIED. RECORD NUMBER 142 IS READ. 11890402
1193: C THE RECORD WAS CREATED IN TEST 19 AND CONTAINS THE FIELD DATA 11900402
1194: C 11910402
1195: C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789' 11920402
1196: C 11930402
1197: C WITHOUT THE SURROUNDING APOSTROPHES. 11940402
1198: C 11950402
1199: C 11960402
1200: IVTNUM = 34 11970402
1201: IF (ICZERO) 30340, 0340, 30340 11980402
1202: 0340 CONTINUE 11990402
1203: CVTN15 = ' ' 12000402
1204: IVCOMP = 0 12010402
1205: IVCORR = 1 12020402
1206: 0342 FORMAT (20X,10X,A) 12030402
1207: READ (I09, 0342) CVTN15 12040402
1208: IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 01234567812050402
1209: 19') IVCOMP = 1 12060402
1210: 40340 IF (IVCOMP - 1) 20340, 10340, 20340 12070402
1211: 30340 IVDELE = IVDELE + 1 12080402
1212: WRITE (I02,80000) IVTNUM 12090402
1213: IF (ICZERO) 10340, 0351, 20340 12100402
1214: 10340 IVPASS = IVPASS + 1 12110402
1215: WRITE (I02,80002) IVTNUM 12120402
1216: GO TO 0351 12130402
1217: 20340 IVFAIL = IVFAIL + 1 12140402
1218: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12150402
1219: 0351 CONTINUE 12160402
1220: C 12170402
1221: C 12180402
1222: C 12190402
1223: C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES 12200402
1224: C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION 12210402
1225: C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM. 12220402
1226: C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED12230402
1227: C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS 12240402
1228: C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL 12250402
1229: C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP 12260402
1230: C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST 12270402
1231: C REPORT AND BEFORE THE TEST REPORT SUMMARY. 12280402
1232: C 12290402
1233: CDB** BEGIN FILE DUMP CODE 12300402
1234: C REWIND I09 12310402
1235: C IRNUM = 1 12320402
1236: C IRLGN = 80 12330402
1237: C ILUN = I09 12340402
1238: C7701 FORMAT (I3,I2,I4,I3,2I4,60A1) 12350402
1239: C7702 FORMAT (1H ,I3,I2,I4,I3,2I4,60A1) 12360402
1240: C7703 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,13H RECORDS - OK) 12370402
1241: C7704 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,27H RECORDS - THERE SHOULD BE , 12380402
1242: C 1I3,9H RECORDS.) 12390402
1243: C DO 7771 IRNUM = 1, ITOTR 12400402
1244: C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12410402
1245: C 1 (IDUMP(ICH), ICH = 1,60) 12420402
1246: C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12430402
1247: C 1 (IDUMP(ICH), ICH = 1,60) 12440402
1248: C IF (IEOF .EQ. 9999) GO TO 7772 12450402
1249: C7771 CONTINUE 12460402
1250: C GO TO 7775 12470402
1251: C7772 IF (IRNUM - ITOTR) 7774, 7773, 7775 12480402
1252: C7773 WRITE (I02, 7703) ILUN, IRNUM 12490402
1253: C GO TO 7779 12500402
1254: C7774 WRITE (I02, 7704) ILUN, IRNUM, ITOTR 12510402
1255: C GO TO 7779 12520402
1256: C7775 DO 7776 I = 1,20 12530402
1257: C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12540402
1258: C 1 (IDUMP(ICH), ICH = 1,60) 12550402
1259: C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12560402
1260: C 1 (IDUMP(ICH), ICH = 1,60) 12570402
1261: C IRNUM = IRNUM + 1 12580402
1262: C IF (IEOF .EQ. 9999) GO TO 7777 12590402
1263: C7776 CONTINUE 12600402
1264: C7777 WRITE (I02, 7704) ILUN, IRNUM, ITOTR 12610402
1265: C7779 CONTINUE 12620402
1266: CDE** END OF DUMP CODE 12630402
1267: C 12640402
1268: C THERE SHOULD BE 34 TESTS IN THIS ROUTINE 12650402
1269: C 12660402
1270: C 12670402
1271: C 12680402
1272: C 12690402
1273: C WRITE OUT TEST SUMMARY 12700402
1274: C 12710402
1275: WRITE (I02,90004) 12720402
1276: WRITE (I02,90014) 12730402
1277: WRITE (I02,90004) 12740402
1278: WRITE (I02,90000) 12750402
1279: WRITE (I02,90004) 12760402
1280: WRITE (I02,90020) IVFAIL 12770402
1281: WRITE (I02,90022) IVPASS 12780402
1282: WRITE (I02,90024) IVDELE 12790402
1283: STOP 12800402
1284: 90001 FORMAT (1H ,24X,5HFM402) 12810402
1285: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM402) 12820402
1286: C 12830402
1287: C FORMATS FOR TEST DETAIL LINES 12840402
1288: C 12850402
1289: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 12860402
1290: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 12870402
1291: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 12880402
1292: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 12890402
1293: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 12900402
1294: C 12910402
1295: C FORMAT STATEMENTS FOR PAGE HEADERS 12920402
1296: C 12930402
1297: 90002 FORMAT (1H1) 12940402
1298: 90004 FORMAT (1H ) 12950402
1299: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 12960402
1300: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 12970402
1301: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 12980402
1302: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 12990402
1303: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 13000402
1304: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 13010402
1305: C 13020402
1306: C FORMAT STATEMENTS FOR RUN SUMMARY 13030402
1307: C 13040402
1308: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 13050402
1309: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 13060402
1310: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 13070402
1311: END 13080402
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.