![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM912.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 FM912.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 root 1: C***********************************************************************00010912
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***** FORTRAN 77 00020912
6: C***** FM912 00030912
7: C***** DIRAF3 - (412) 00040912
8: C***** THIS PROGRAM CALLS SUBROUTINE SN913 IN FILE FM913 00050912
9: C***********************************************************************00060912
10: C***** TESTING OF DIRECT ACCESS FILES ANS REF 00070912
11: C***** FORMATTED, WITH BOTH SEQUENTIAL AND DIRECT 12.5 00080912
12: C***** ACCESS TO THE SAME FILE 00090912
13: C***** 00100912
14: C***** USES SUBROUTINE SN913 FAQ 00110912
15: C***** 00120912
16: C***** S P E C I F I C A T I O N S SEGMENT 412 00130912
17: C***********************************************************************00140912
18: DIMENSION F1S(10), G1S(10) 00150912
19: CHARACTER*20 A20VK, B20VK, C20VK, A201K(10), B201K(10) 00160912
20: CHARACTER*47 A47VK, B47VK, C47VK 00170912
21: CHARACTER*51 A51VK 00180912
22: CHARACTER*12 A12VK 00190912
23: CHARACTER A120VK*120, B120VK*120, A1VK*1, A4VK*4 00200912
24: CHARACTER*31 REMK,REMK1,REMK2,REMK3,REMK4,REMK5,REMK45 00210912
25: LOGICAL AVB, BVB, CVB, C1B(10), D1B(10) 00220912
26: DOUBLE PRECISION AVD, BVD, CVD, DVD, D1D(10), B1D(15) 00230912
27: C***** 00240912
28: C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00250912
29: CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING 00260912
30: CHARACTER*15 CDIR 00270912
31: C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-130 00280912
32: C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR. 00290912
33: CBB** ********************** BBCINITA **********************************00300912
34: C**** SPECIFICATION STATEMENTS 00310912
35: C**** 00320912
36: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330912
37: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340912
38: CBE** ********************** BBCINITA **********************************00350912
39: CBB** ********************** BBCINITB **********************************00360912
40: C**** INITIALIZE SECTION 00370912
41: DATA ZVERS, ZVERSD, ZDATE 00380912
42: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00390912
43: DATA ZCOMPL, ZNAME, ZTAPE 00400912
44: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410912
45: DATA ZPROJ, ZTAPED, ZPROG 00420912
46: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430912
47: DATA REMRKS /' '/ 00440912
48: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450912
49: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460912
50: C**** 00470912
51: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480912
52: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490912
53: CZ03 ZPROG = 'PROGRAM NAME' 00500912
54: ZDATE = '07-Nov-85 ' *RP
55: ZCOMPL = 'CCI 5.2 ' *RP
56: ZPROJ = 'TC-85- -410' *RP
57: ZNAME = ' ' *RP
58: ZTAPE = ' ' *RP
59: ZTAPED = '850703 ' *RP
60: C 00570912
61: IVPASS = 0 00580912
62: IVFAIL = 0 00590912
63: IVDELE = 0 00600912
64: IVINSP = 0 00610912
65: IVTOTL = 0 00620912
66: IVTOTN = 0 00630912
67: ICZERO = 0 00640912
68: C 00650912
69: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660912
70: I01 = 05 00670912
71: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680912
72: I02 = 06 00690912
73: C 00700912
74: I01 = 5 00710912
75: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720912
76: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730912
77: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740912
78: C 00750912
79: I02 = 6 00760912
80: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770912
81: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780912
82: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790912
83: C 00800912
84: CBE** ********************** BBCINITB **********************************00810912
85: C***** 00820912
86: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE 00830912
87: C***** UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED. 00840912
88: C***** 00850912
89: C I13 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE. 00860912
90: I13 = 24 00870912
91: OPEN(UNIT=I13,ACCESS='DIRECT',FORM='FORMATTED',RECL=80) 00880912
92: C SPECIFYING I13 = NN OVERRIDES THE DEFAULT I13 = 24. 00890912
93: C 00900912
94: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 00910912
95: C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 00920912
96: C***** FORMATTED FILE. 00930912
97: C***** 00940912
98: C CDIR CONTAINS THE FILE NAME FOR UNIT I13. 00950912
99: CDIR = ' DIRFILE' 00960912
100: C 00970912
101: CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS 00980912
102: C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH 00990912
103: C X-130 THAN THE DEFAULT CDIR = ' DIRFILE'. 01000912
104: C 01010912
105: C***** FILE NUMBER AND NAME ASSIGNMENT 01020912
106: NUVI = I02 01030912
107: KUVI = I13 01040912
108: IVTOTL = 26 01050912
109: ZPROG = 'FM912' 01060912
110: C***** 01070912
111: C***** FILE NUMBER AND NAME ASSIGNMENT 01080912
112: C***** 01090912
113: REMK1='RECORD 1 - ERR PATH TAKEN' 01100912
114: REMK2='RECORD 2 - ERR PATH TAKEN' 01110912
115: REMK3='RECORD 3 - ERR PATH TAKEN' 01120912
116: REMK4='RECORD 4 - ERR PATH TAKEN' 01130912
117: REMK5='RECORD 5 - ERR PATH TAKEN' 01140912
118: REMK45='RECORD 4 + 5 - ERR PATH TAKEN' 01150912
119: CBB** ********************** BBCHED0A **********************************01160912
120: C**** 01170912
121: C**** WRITE REPORT TITLE 01180912
122: C**** 01190912
123: WRITE (I02, 90002) 01200912
124: WRITE (I02, 90006) 01210912
125: WRITE (I02, 90007) 01220912
126: WRITE (I02, 90008) ZVERS, ZVERSD 01230912
127: WRITE (I02, 90009) ZPROG, ZPROG 01240912
128: WRITE (I02, 90010) ZDATE, ZCOMPL 01250912
129: CBE** ********************** BBCHED0A **********************************01260912
130: WRITE(NUVI,41200) 01270912
131: 41200 FORMAT( 1H ,/45H DIRAF3 - (412) DIRECT ACCESS FORMATTED FILE/ 01280912
132: 1 42H WITH OPTION TO OPEN AS A SEQUENTIAL FILE/ 01290912
133: 2 17H ANS REF. - 12.5) 01300912
134: CBB** ********************** BBCHED0B **********************************01310912
135: C**** WRITE DETAIL REPORT HEADERS 01320912
136: C**** 01330912
137: WRITE (I02,90004) 01340912
138: WRITE (I02,90004) 01350912
139: WRITE (I02,90013) 01360912
140: WRITE (I02,90014) 01370912
141: WRITE (I02,90015) IVTOTL 01380912
142: CBE** ********************** BBCHED0B **********************************01390912
143: C***** 01400912
144: C***** PLUS OR MINUS VALUES 01410912
145: C***** 01420912
146: CVS = 0.0001 01430912
147: CVD = 0.0001D0 01440912
148: C***** 01450912
149: C***** INITIALIZE DATA ARRAYS 01460912
150: C***** 01470912
151: CALL SN913(F1S,G1S,C1B,D1B,D1D,B1D,A201K,B201K) 01480912
152: C***** 01490912
153: C***** OPEN DIRECT ACCESS FILE - STATUS=NEW 01500912
154: C***** 01510912
155: OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',RECL=120, 01520912
156: 1 FORM='FORMATTED',STATUS='NEW') 01530912
157: C***** 01540912
158: CT001* TEST 1 - CHECKS RECL AND NEXTREC 01550912
159: C***** FOR JUST OPENED DIRECT ACCESS FILE 01560912
160: C***** 01570912
161: IVTNUM=1 01580912
162: INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI) 01590912
163: IF (IVI .NE. 120) GO TO 33020 01600912
164: IF (KVI .NE. 1) GO TO 33020 01610912
165: WRITE(NUVI,80002)IVTNUM 01620912
166: IVPASS=IVPASS+1 01630912
167: GO TO 33030 01640912
168: 33020 REMK='ERROR IN INQUIRE' 01650912
169: WRITE(NUVI,55010)IVTNUM,REMK 01660912
170: 55010 FORMAT(1H ,5HTEST ,I3,1X,5H FAIL,34X,A31) 01670912
171: IVFAIL=IVFAIL+1 01680912
172: WRITE(NUVI,55020)IVI,KVI 01690912
173: 55020 FORMAT(1H ,/,11X,16HCOMPUTED: RECL=,I6,5X,8HNEXTREC=,I6) 01700912
174: WRITE(NUVI,55030) 01710912
175: 55030 FORMAT(1H ,10X,22HCORRECT: RECL= 120,5X,14HNEXTREC= 1/) 01720912
176: C***** 01730912
177: CT002* TEST 2 - WRITES RECORD 1 01740912
178: C***** 01750912
179: 33030 IVTNUM=2 01760912
180: IVI = 1 01770912
181: AVS = F1S (IVI) 01780912
182: BVS = F1S(IVI + 1) 01790912
183: A20VK = A201K (IVI) 01800912
184: AVB = C1B (IVI) 01810912
185: AVD = D1D (IVI) 01820912
186: WRITE(UNIT=KUVI,REC=1,FMT=41204,ERR=33040) IVI, AVS, BVS, AVD, 01830912
187: 1 AVB, A20VK 01840912
188: 41204 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 35X, ' LAST RECORD') 01850912
189: WRITE(NUVI,80002)IVTNUM 01860912
190: IVPASS=IVPASS+1 01870912
191: GO TO 33050 01880912
192: 33040 WRITE(NUVI,55010)IVTNUM,REMK1 01890912
193: IVFAIL=IVFAIL+1 01900912
194: C***** 01910912
195: CT003* TEST 3 - WRITES RECORD 2 01920912
196: C***** 01930912
197: 33050 IVTNUM=3 01940912
198: IVI = IVI + 1 01950912
199: AVS = F1S (IVI) 01960912
200: BVS = F1S(IVI + 1) 01970912
201: A20VK = A201K (IVI) 01980912
202: AVB = C1B (IVI) 01990912
203: AVD = D1D (IVI) 02000912
204: WRITE(UNIT=KUVI,REC=2,FMT=41205,ERR=33060) BVS, AVD, IVI, AVS, 02010912
205: 1 AVB, A20VK 02020912
206: 41205 FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, 30X, ' LASTS RECORD') 02030912
207: WRITE(NUVI,80002)IVTNUM 02040912
208: IVPASS=IVPASS+1 02050912
209: GO TO 33070 02060912
210: 33060 WRITE(NUVI,55010)IVTNUM,REMK2 02070912
211: IVFAIL=IVFAIL+1 02080912
212: C***** 02090912
213: CT004* TEST 4 - WRITES RECORD 3 02100912
214: C***** 02110912
215: 33070 IVTNUM=4 02120912
216: IVI = IVI + 1 02130912
217: AVS = F1S (IVI) 02140912
218: BVS = F1S(IVI + 1) 02150912
219: A20VK = A201K (IVI) 02160912
220: AVB = C1B (IVI) 02170912
221: AVD = D1D (IVI) 02180912
222: WRITE(UNIT=KUVI,REC=3,FMT=41206,ERR=33080) IVI, BVS, AVS, AVD, 02190912
223: 1 AVB, A20VK 02200912
224: 41206 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 30X, 'THE LAST REC') 02210912
225: WRITE(NUVI,80002)IVTNUM 02220912
226: IVPASS=IVPASS+1 02230912
227: GO TO 33090 02240912
228: 02250912
229: 33080 WRITE(NUVI,55010)IVTNUM,REMK3 02260912
230: IVFAIL=IVFAIL+1 02270912
231: C***** 02280912
232: CT005* TEST 5 - WRITES RECORDS 4 AND 5 WITH ONE WRITE 02290912
233: C***** 02300912
234: 33090 IVTNUM=5 02310912
235: IVI = IVI + 1 02320912
236: AVS = F1S (IVI) 02330912
237: BVS = F1S(IVI + 1) 02340912
238: A20VK = A201K (IVI) 02350912
239: AVB = C1B (IVI) 02360912
240: AVD = D1D (IVI) 02370912
241: WRITE(UNIT=KUVI,REC=4,FMT=41207,ERR=33100) IVI, AVS, AVD, AVB, 02380912
242: 1 A20VK, BVS, BVS, AVD, AVB, IVI, AVS, A20VK 02390912
243: 41207 FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, 35X, 'NEXT TO LAST',/ 02400912
244: 1 E12.6, D15.7, L2, I4, F11.5, A25, 30X, 'THE END') 02410912
245: WRITE(NUVI,80002)IVTNUM 02420912
246: IVPASS=IVPASS+1 02430912
247: GO TO 33290 02440912
248: 33100 WRITE(NUVI,55010)IVTNUM,REMK45 02450912
249: IVFAIL=IVFAIL+1 02460912
250: C***** 02470912
251: CT006* TEST 6 - CHECK RECL AND NEXTREC ON OPENED FILE 02480912
252: C***** 02490912
253: 33290 IVTNUM=6 02500912
254: INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI) 02510912
255: IF (IVI .NE. 120)GO TO 33300 02520912
256: IF(KVI .NE. 6)GO TO 33300 02530912
257: WRITE(NUVI,80002)IVTNUM 02540912
258: IVPASS=IVPASS+1 02550912
259: GO TO 33110 02560912
260: 33300 REMK='ERROR IN INQUIRE' 02570912
261: WRITE(NUVI,55010)IVTNUM,REMK 02580912
262: IVFAIL=IVFAIL+1 02590912
263: WRITE(NUVI,55020)IVI,KVI 02600912
264: WRITE(NUVI,55040) 02610912
265: 55040 FORMAT(1H ,10X,22HCORRECT: RECL= 120,5X,14HNEXTREC= 6/) 02620912
266: C***** 02630912
267: CT007* TEST 7 - READS RECORD 1 02640912
268: C***** 02650912
269: 33110 IVTNUM=7 02660912
270: IVI = 1 02670912
271: READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33120) KVI, AVS, BVS, AVD, 02680912
272: 1 AVB, A20VK, A47VK 02690912
273: 41210 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, A47) 02700912
274: ISWT=1 02710912
275: GO TO 33220 02720912
276: 02730912
277: 33120 WRITE(NUVI,55010)IVTNUM,REMK1 02740912
278: IVFAIL=IVFAIL+1 02750912
279: C***** 02760912
280: CT008* TEST 8 - READS RECORD 2 02770912
281: C***** 02780912
282: 33130 IVTNUM=8 02790912
283: IVI = 2 02800912
284: READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33140) BVS, AVD, KVI, AVS, 02810912
285: 1 AVB, A20VK, A51VK 02820912
286: 41238 FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, A51) 02830912
287: ISWT=2 02840912
288: GO TO 33230 02850912
289: 02860912
290: 33140 WRITE(NUVI,55010)IVTNUM,REMK2 02870912
291: IVFAIL=IVFAIL+1 02880912
292: C***** 02890912
293: CT009* TEST 9 - READS RECORD 3 02900912
294: C***** 02910912
295: 33150 IVTNUM=9 02920912
296: IVI = 3 02930912
297: READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33160) LVI, DVS, GVS, BVD, 02940912
298: 1 BVB, B20VK, B47VK 02950912
299: ISWT=3 02960912
300: GO TO 33240 02970912
301: 02980912
302: 33160 WRITE(NUVI,55010)IVTNUM,REMK3 02990912
303: IVFAIL=IVFAIL+1 03000912
304: C***** 03010912
305: CT010* TEST 10 - READS RECORD 4 03020912
306: C***** 03030912
307: 33170 IVTNUM=10 03040912
308: IVI = 4 03050912
309: READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33180) NVI, EVS, DVD, CVB, 03060912
310: 1 C20VK, FVS, C47VK 03070912
311: 41241 FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, A47) 03080912
312: ISWT=4 03090912
313: GO TO 33250 03100912
314: 03110912
315: 33180 WRITE(NUVI,55010)IVTNUM,REMK4 03120912
316: IVFAIL=IVFAIL+1 03130912
317: C***** 03140912
318: CT011* TEST 11 - READS RECORD 5 03150912
319: C***** 03160912
320: 33190 IVTNUM=11 03170912
321: IVI = 5 03180912
322: JVI = 4 03190912
323: READ(UNIT=KUVI,REC=IVI,FMT=41218,ERR=33200) BVS, AVD, AVB, KVI, 03200912
324: 1 AVS, A20VK, A51VK 03210912
325: 41218 FORMAT(E12.6, D15.7, L2, I4, F11.5, A25, A51) 03220912
326: ISWT=5 03230912
327: GO TO 33260 03240912
328: 03250912
329: 33200 WRITE(NUVI,55010)IVTNUM,REMK5 03260912
330: IVFAIL=IVFAIL+1 03270912
331: C***** 03280912
332: CT012* TEST 12 - OVERWRITES RECORD 3 03290912
333: C***** 03300912
334: 33210 IVTNUM=12 03310912
335: IVI = 3 03320912
336: AVS = G1S (IVI) 03330912
337: BVS = G1S(IVI + 1) 03340912
338: A20VK = B201K (IVI) 03350912
339: AVB = D1B (IVI) 03360912
340: AVD = B1D (IVI) 03370912
341: WRITE(UNIT=KUVI,REC=3,FMT=41251,ERR=33310) IVI, AVS, BVS, AVD, 03380912
342: 1 A20VK, AVB 03390912
343: 41251 FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, 35X, 'NEW RECORD ') 03400912
344: WRITE(NUVI,80002)IVTNUM 03410912
345: IVPASS=IVPASS+1 03420912
346: GO TO 33320 03430912
347: 03440912
348: 33310 WRITE(NUVI,55010)IVTNUM,REMK3 03450912
349: IVFAIL=IVFAIL+1 03460912
350: C***** 03470912
351: CT013* TEST 13 - OVERWRITES RECORD 5 03480912
352: C***** 03490912
353: 33320 IVTNUM=13 03500912
354: IVI = 5 03510912
355: AVS = G1S (IVI) 03520912
356: BVS = G1S(IVI - 1) 03530912
357: A20VK = B201K (IVI) 03540912
358: AVB = D1B (IVI) 03550912
359: AVD = B1D (IVI) 03560912
360: WRITE(UNIT=KUVI,REC=5,FMT=41252,ERR=33330) AVS, IVI, A20VK, AVD,03570912
361: 1 BVS, AVB 03580912
362: 41252 FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, 35X, 'STOP RECORD') 03590912
363: WRITE(NUVI,80002)IVTNUM 03600912
364: IVPASS=IVPASS+1 03610912
365: GO TO 33340 03620912
366: 03630912
367: 33330 WRITE(NUVI,55010)IVTNUM,REMK5 03640912
368: IVFAIL=IVFAIL+1 03650912
369: C***** 03660912
370: C***** CLOSE AND REOPEN DIRECT ACCESS FILE 03670912
371: C***** 03680912
372: 33340 CLOSE(UNIT=KUVI) 03690912
373: OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD', 03700912
374: 1 FORM='FORMATTED',RECL=120) 03710912
375: C***** 03720912
376: CT014* TEST 14 - READS RECORD 4 03730912
377: C***** 03740912
378: IVTNUM=14 03750912
379: IVI = 4 03760912
380: READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33350) NVI, EVS, DVD, CVB, 03770912
381: 1 C20VK, FVS, C47VK 03780912
382: ISWT=6 03790912
383: GO TO 33250 03800912
384: 03810912
385: 33350 WRITE(NUVI,55010)IVTNUM,REMK4 03820912
386: IVFAIL=IVFAIL+1 03830912
387: C***** 03840912
388: CT015* TEST 15 - READS THE CHANGED RECORD 5 03850912
389: C***** 03860912
390: 33360 IVTNUM=15 03870912
391: IVI = 5 03880912
392: READ(UNIT=KUVI,REC=IVI,FMT=41254,ERR=33370) AVS, KVI, A20VK, 03890912
393: 1 AVD, BVS, AVB, A47VK03900912
394: 41254 FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, A47) 03910912
395: ISWT=7 03920912
396: IF (KVI .NE. IVI) GOTO 41221 03930912
397: IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 4122303940912
398: IF (BVS.LT.G1S(IVI-1)-CVS .OR. BVS.GT.G1S(IVI-1)+CVS) GOTO 4122503950912
399: IF (A20VK .NE. B201K(IVI)) GOTO 41229 03960912
400: IF ((AVB .AND. .NOT. D1B(IVI)) .OR. 03970912
401: 1 (.NOT. AVB .AND. D1B(IVI))) GOTO 41233 03980912
402: IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 4122703990912
403: IF (A47VK .NE. 04000912
404: 1 ' STOP RECORD') GOTO 41231 04010912
405: WRITE(NUVI,80002)IVTNUM 04020912
406: IVPASS=IVPASS+1 04030912
407: GO TO 33380 04040912
408: 33370 WRITE(NUVI,55010)IVTNUM,REMK5 04050912
409: IVFAIL=IVFAIL+1 04060912
410: C***** 04070912
411: CT016* TEST 16 - READS RECORD 2 04080912
412: C***** 04090912
413: 33380 IVTNUM=16 04100912
414: IVI = 2 04110912
415: READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33390) BVS, AVD, KVI, AVS, 04120912
416: 1 AVB, A20VK, A51VK 04130912
417: ISWT=8 04140912
418: GO TO 33230 04150912
419: 04160912
420: 33390 WRITE(NUVI,55010)IVTNUM,REMK2 04170912
421: IVFAIL=IVFAIL+1 04180912
422: C***** 04190912
423: CT017* TEST 17 - READS THE CHANGED RECORD 3 04200912
424: C***** 04210912
425: 33400 IVTNUM=17 04220912
426: IVI = 3 04230912
427: READ(UNIT=KUVI,REC=3,FMT=41256,ERR=33410) KVI, AVS, BVS, AVD, 04240912
428: 1 A20VK, AVB, A47VK 04250912
429: 41256 FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, A47) 04260912
430: ISWT=9 04270912
431: IF (KVI .NE. IVI) GOTO 41221 04280912
432: IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 4122304290912
433: IF (BVS.LT.G1S(IVI+1)-CVS .OR. BVS.GT.G1S(IVI+1)+CVS) GOTO 4122504300912
434: IF (A20VK .NE. B201K(IVI)) GOTO 41229 04310912
435: IF ((AVB .AND. .NOT. D1B(IVI)) .OR. 04320912
436: 1 (.NOT. AVB .AND. D1B(IVI))) GOTO 41233 04330912
437: IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 4122704340912
438: IF (A47VK .NE. 04350912
439: 1 ' NEW RECORD ') GOTO 41231 04360912
440: WRITE(NUVI,80002)IVTNUM 04370912
441: IVPASS=IVPASS+1 04380912
442: GO TO 33420 04390912
443: 04400912
444: 33410 WRITE(NUVI,55010)IVTNUM,REMK3 04410912
445: IVFAIL=IVFAIL+1 04420912
446: C***** 04430912
447: CT018* TEST 18 - READS RECORD 1 04440912
448: C***** 04450912
449: 33420 IVTNUM=18 04460912
450: IVI = 1 04470912
451: READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33430) KVI, AVS, BVS, AVD, 04480912
452: 1 AVB, A20VK, A47VK 04490912
453: ISWT=10 04500912
454: GO TO 33220 04510912
455: 04520912
456: 33430 WRITE(NUVI,55010)IVTNUM,REMK1 04530912
457: IVFAIL=IVFAIL+1 04540912
458: C***** 04550912
459: CT019* TEST 19 - OVERWRITES RECORD 4 04560912
460: C***** 04570912
461: 33440 IVTNUM=19 04580912
462: 41258 IVI = 4 04590912
463: KVI = IVI + 1 04600912
464: AVS = F1S (IVI) 04610912
465: BVS = F1S(IVI + 1) 04620912
466: EVS = F1S(IVI) + 2.34 04630912
467: AVD = D1D (IVI) 04640912
468: WRITE(UNIT=KUVI,REC=4,FMT=41259,ERR=33450) IVI, KVI, AVS, BVS, 04650912
469: 1 EVS, AVD 04660912
470: 41259 FORMAT(I5, I5.3, F10.5, E14.6, E20.1E4, D14.8) 04670912
471: WRITE(NUVI,80002)IVTNUM 04680912
472: IVPASS=IVPASS+1 04690912
473: GO TO 33460 04700912
474: 04710912
475: 33450 WRITE(NUVI,55010)IVTNUM,REMK4 04720912
476: IVFAIL=IVFAIL+1 04730912
477: C***** 04740912
478: CT020* TEST 20 - OVERWRITES RECORDS 1, 2, AND 3 04750912
479: C***** 04760912
480: 33460 IVTNUM=20 04770912
481: IVI = 1 04780912
482: A1VK = 'A' 04790912
483: A4VK = A201K (IVI) (1:4) 04800912
484: AVB = C1B (IVI) 04810912
485: AVD = D1D (IVI) 04820912
486: BVD = D1D (IVI) + 3.234D2 04830912
487: WRITE(UNIT=KUVI,REC=1,FMT=41260,ERR=33470) AVD, BVD, AVB, A1VK, 04840912
488: 1 A4VK 04850912
489: 41260 FORMAT(G14.8, G20.2E4, L2, A, A4, 'TSAL DROCER',//, 04860912
490: 1 10HHOLLERITH , T15, 'ONE', 10X, TL5, 'TWO', TR5, 04870912
491: 2 'THREE', :, 'LAST') 04880912
492: WRITE(NUVI,80002)IVTNUM 04890912
493: IVPASS=IVPASS+1 04900912
494: GO TO 33480 04910912
495: 04920912
496: 33470 WRITE(NUVI,55010)IVTNUM,REMK1 04930912
497: IVFAIL=IVFAIL+1 04940912
498: C***** 04950912
499: CT021* TEST 21 - OVERWRITES RECORD 5 04960912
500: C***** 04970912
501: 33480 IVTNUM=21 04980912
502: IVI = 5 04990912
503: BVS = F1S(IVI - 1) 05000912
504: AVD = B1D (4) 05010912
505: WRITE(UNIT=KUVI,REC=5,FMT=41261,ERR=33490) IVI, BVS, IVI, AVD 05020912
506: 41261 FORMAT(SP, I5, S, F10.5, SS, I5, 3PE14.6E2) 05030912
507: WRITE(NUVI,80002)IVTNUM 05040912
508: IVPASS=IVPASS+1 05050912
509: GO TO 33500 05060912
510: 05070912
511: 33490 WRITE(NUVI,55010)IVTNUM,REMK5 05080912
512: IVFAIL=IVFAIL+1 05090912
513: C***** 05100912
514: C***** CLOSE AND REOPEN DIRECT ACCESS FILE 05110912
515: C***** 05120912
516: 33500 CLOSE(UNIT=KUVI) 05130912
517: OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD', 05140912
518: 1 FORM='FORMATTED',RECL=120) 05150912
519: C***** 05160912
520: CT022* TEST 22 - READS RECORD 1 05170912
521: C***** 05180912
522: IVTNUM=22 05190912
523: IVI = 1 05200912
524: READ(UNIT=KUVI,REC=IVI,FMT=41262,ERR=33510) AVD, A20VK, AVB, 05210912
525: 1 A1VK, A4VK, A12VK 05220912
526: 41262 FORMAT(G14.8, A20, L2, A, A4, A12) 05230912
527: ISWT=1 05240912
528: IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4127705250912
529: IF (A20VK(12:20) .NE. '.34E+0003') GOTO 41279 05260912
530: IF ((A1VK .NE. 'A') .OR. 05270912
531: 1 (A4VK .NE. A201K(IVI)(1:4)) .OR. 05280912
532: 2 (A12VK .NE. 'TSAL DROCER')) GOTO 41279 05290*TI
533: WRITE(NUVI,80002)IVTNUM 05300912
534: IVPASS=IVPASS+1 05310912
535: GO TO 33520 05320912
536: 05330912
537: 33510 WRITE(NUVI,55010)IVTNUM,REMK1 05340912
538: IVFAIL=IVFAIL+1 05350912
539: C***** RECORD # 4 05360912
540: CT023* TEST 23 - READS RECORD 4 05370912
541: C***** 05380912
542: 33520 IVTNUM=23 05390912
543: IVI = 4 05400912
544: READ(UNIT=KUVI,REC=IVI,FMT=41266,ERR=33530) KVI, A20VK, AVS, 05410912
545: 1 BVS, B20VK, AVD 05420912
546: 41266 FORMAT(I5, A5, F10.5, E14.6, A20, D14.8) 05430912
547: ISWT=2 05440912
548: IF (A20VK(3:5) .NE. '005') GOTO 41293 05450912
549: IF ((AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) .OR. 05460912
550: 1 (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) .OR. 05470912
551: 2 (B20VK(13:20) .NE. '.6E+0001')) GOTO 41293 05480*TI
552: WRITE(NUVI,80002)IVTNUM 05490912
553: IVPASS=IVPASS+1 05500912
554: GO TO 33540 05510912
555: 05520912
556: 33530 WRITE(NUVI,55010)IVTNUM,REMK4 05530912
557: IVFAIL=IVFAIL+1 05540912
558: C***** 05550912
559: CT024* TEST 24 - READS RECORD 2 TESTS FOR BLANK RECORD 05560912
560: C***** 05570912
561: 33540 IVTNUM=24 05580912
562: B120VK = ' ' 05590912
563: IVI = 2 05600912
564: READ(UNIT=KUVI,REC=IVI,FMT=41269,ERR=33550) A120VK 05610912
565: 41269 FORMAT(A120) 05620912
566: ISWT=3 05630912
567: IF (A120VK .NE. B120VK) GOTO 41281 05640912
568: WRITE(NUVI,80002)IVTNUM 05650912
569: IVPASS=IVPASS+1 05660912
570: GO TO 33560 05670912
571: 05680912
572: 33550 WRITE(NUVI,55010)IVTNUM,REMK2 05690912
573: IVFAIL=IVFAIL+1 05700912
574: C***** 05710912
575: CT025* TEST 25 - READS RECORD 5 05720912
576: C***** 05730912
577: 33560 IVTNUM=25 05740912
578: IVI = 5 05750912
579: READ(UNIT=KUVI,REC=IVI,FMT=41271,ERR=33570) A20VK(1:5), AVS, 05760912
580: 1 B20VK, C20VK 05770912
581: 41271 FORMAT(A5, F10.5, BZ, A5, BN, A20) 05780912
582: ISWT=4 05790912
583: IF (A20VK(1:5) .NE. ' +5') GOTO 41283 05800912
584: IF (B20VK(1:5) .NE. ' 5') GOTO 41285 05810912
585: IF (C20VK(1:14) .NE. ' 625.0000E-03') GOTO 41287 05820912
586: WRITE(NUVI,80002)IVTNUM 05830912
587: IVPASS=IVPASS+1 05840912
588: GO TO 33580 05850912
589: 05860912
590: 33570 WRITE(NUVI,55010)IVTNUM,REMK5 05870912
591: IVFAIL=IVFAIL+1 05880912
592: C***** 05890912
593: CT026* TEST 26 - READS RECORD 3 05900912
594: C***** 05910912
595: 33580 IVTNUM=26 05920912
596: IVI = 3 05930912
597: READ(UNIT=KUVI,REC=IVI,FMT=41275,ERR=33590) A120VK 05940912
598: 41275 FORMAT(A120) 05950912
599: ISWT=5 05960912
600: IF (A120VK(1:10) .NE. 'HOLLERITH') GOTO 41289 05970912
601: IF (A120VK(11:40) .NE. 05980912
602: 1 ' ONE TWO THREE ') GOTO 41291 05990912
603: WRITE(NUVI,80002)IVTNUM 06000912
604: IVPASS=IVPASS+1 06010912
605: GO TO 33600 06020912
606: 06030912
607: 33590 WRITE(NUVI,55010)IVTNUM,REMK3 06040912
608: IVFAIL=IVFAIL+1 06050912
609: C***** 06060912
610: C***** CLOSE DIRECT ACCESS FILE 06070912
611: C***** 06080912
612: 33600 CLOSE(UNIT=KUVI,STATUS='DELETE') 06090912
613: GO TO 33610 06100912
614: C***** 06110912
615: C***** CHECKING RECORD 1 06120912
616: C***** 06130912
617: 33220 IF (KVI .NE. IVI) GOTO 41221 06140912
618: IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 4122306150912
619: IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 4122506160912
620: IF (A20VK .NE. A201K(IVI)) GOTO 41229 06170912
621: IF (A47VK .NE. 06180912
622: 1 ' LAST RECORD') GOTO 41231 06190912
623: IF ((AVB .AND. .NOT. C1B(IVI)) .OR. 06200912
624: 1 (.NOT. AVB .AND. C1B(IVI))) GOTO 41233 06210912
625: IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4122706220912
626: WRITE(NUVI,80002)IVTNUM 06230912
627: IVPASS=IVPASS+1 06240912
628: IF (ISWT .EQ. 10)GO TO 33440 06250912
629: GO TO 33130 06260912
630: 06270912
631: 41221 WRITE(NUVI,41222)IVTNUM,IVI 06280912
632: IVFAIL=IVFAIL+1 06290912
633: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06300912
634: 1 33420,33440)ISWT 06310912
635: 06320912
636: 41223 WRITE(NUVI,41224)IVTNUM,IVI 06330912
637: IVFAIL=IVFAIL+1 06340912
638: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06350912
639: 1 33420,33440)ISWT 06360912
640: 06370912
641: 41225 WRITE(NUVI,41226)IVTNUM,IVI 06380912
642: IVFAIL=IVFAIL+1 06390912
643: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06400912
644: 1 33420,33440)ISWT 06410912
645: 06420912
646: 41227 WRITE(NUVI,41228)IVTNUM,IVI 06430912
647: IVFAIL=IVFAIL+1 06440912
648: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06450912
649: 1 33420,33440)ISWT 06460912
650: 06470912
651: 41229 WRITE(NUVI,41230)IVTNUM,IVI 06480912
652: IVFAIL=IVFAIL+1 06490912
653: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06500912
654: 1 33420,33440)ISWT 06510912
655: 06520912
656: 41231 WRITE(NUVI,41232)IVTNUM,IVI 06530912
657: IVFAIL=IVFAIL+1 06540912
658: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06550912
659: 1 33420,33440)ISWT 06560912
660: 06570912
661: 41233 WRITE(NUVI,41234)IVTNUM,IVI 06580912
662: IVFAIL=IVFAIL+1 06590912
663: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06600912
664: 1 33420,33440)ISWT 06610912
665: C***** 06620912
666: C***** CHECKING RECORD 2 06630912
667: C***** 06640912
668: 33230 IF (KVI .NE. IVI) GOTO 41221 06650912
669: IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 4122306660912
670: IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 4122506670912
671: IF (A20VK .NE. A201K(IVI)) GOTO 41229 06680912
672: IF ((AVB .AND. .NOT. C1B(IVI)) .OR. 06690912
673: 1 (.NOT. AVB .AND. C1B(IVI))) GOTO 41233 06700912
674: IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4122706710912
675: IF (A51VK .NE. 06720912
676: 1 ' LASTS RECORD ')GOTO 41231 06730912
677: WRITE(NUVI,80002)IVTNUM 06740912
678: IVPASS=IVPASS+1 06750912
679: IF (ISWT .EQ. 8)GO TO 33400 06760912
680: GO TO 33150 06770912
681: C***** 06780912
682: C***** CHECKING RECORD 3 06790912
683: C***** 06800912
684: 33240 IF (LVI .NE. IVI) GOTO 41221 06810912
685: IF (GVS .LT. F1S(IVI)-CVS .OR. GVS .GT. F1S(IVI)+CVS) GOTO 4122306820912
686: IF (DVS.LT.F1S(IVI+1)-CVS .OR. DVS.GT.F1S(IVI+1)+CVS) GOTO 4122506830912
687: IF (B20VK .NE. A201K(IVI)) GOTO 41229 06840912
688: IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 06850912
689: 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 41233 06860912
690: IF (BVD .LT. D1D(IVI)-CVD .OR. BVD .GT. D1D(IVI)+CVD) GOTO 4122706870912
691: IF (B47VK .NE. 06880912
692: 1 ' THE LAST REC ') GOTO 41231 06890912
693: WRITE(NUVI,80002)IVTNUM 06900912
694: IVPASS=IVPASS+1 06910912
695: GO TO 33170 06920912
696: C***** 06930912
697: C***** CHECKING RECORD 4 06940912
698: C***** 06950912
699: 33250 IF (NVI .NE. IVI) GOTO 41221 06960912
700: IF (EVS .LT. F1S(IVI)-CVS .OR. EVS .GT. F1S(IVI)+CVS) GOTO 4122306970912
701: IF (FVS.LT.F1S(IVI+1)-CVS .OR. FVS.GT.F1S(IVI+1)+CVS) GOTO 4122506980912
702: IF (C20VK .NE. A201K(IVI)) GOTO 41229 06990912
703: IF ((CVB .AND. .NOT. C1B(IVI)) .OR. 07000912
704: 1 (.NOT. CVB .AND. C1B(IVI))) GOTO 41233 07010912
705: IF (DVD .LT. D1D(IVI)-CVD .OR. DVD .GT. D1D(IVI)+CVD) GOTO 4122707020912
706: IF (C47VK .NE. 07030912
707: 1 ' NEXT TO LAST') GOTO 41231 07040912
708: WRITE(NUVI,80002)IVTNUM 07050912
709: IVPASS=IVPASS+1 07060912
710: IF (ISWT .EQ. 6)GO TO 33360 07070912
711: GO TO 33190 07080912
712: C***** 07090912
713: C***** CHECKING RECORD 5 07100912
714: C***** 07110912
715: 33260 IF (KVI .NE. JVI) GOTO 41221 07120912
716: IF (AVS .LT. F1S(JVI)-CVS .OR. AVS .GT. F1S(JVI)+CVS) GOTO 4122307130912
717: IF (BVS.LT.F1S(JVI+1)-CVS .OR. BVS.GT.F1S(JVI+1)+CVS) GOTO 4122507140912
718: IF (A20VK .NE. A201K(JVI)) GOTO 41229 07150912
719: IF ((AVB .AND. .NOT. C1B(JVI)) .OR. 07160912
720: 1 (.NOT. AVB .AND. C1B(JVI))) GOTO 41233 07170912
721: IF (AVD .LT. D1D(JVI)-CVD .OR. AVD .GT. D1D(JVI)+CVD) GOTO 4122707180912
722: IF (A51VK .NE. 07190912
723: 1 ' THE END ') GOTO 4123107200912
724: WRITE(NUVI,80002)IVTNUM 07210912
725: IVPASS=IVPASS+1 07220912
726: GO TO 33210 07230912
727: C***** 07240912
728: C***** 07250912
729: C***** 07260912
730: 41277 WRITE(NUVI,41278)IVTNUM,IVI 07270912
731: IVFAIL=IVFAIL+1 07280912
732: GO TO(33520,33540,33560,33580,33600)ISWT 07290912
733: 07300912
734: 41279 WRITE(NUVI,41280)IVTNUM,IVI 07310912
735: IVFAIL=IVFAIL+1 07320912
736: GO TO(33520,33540,33560,33580,33600)ISWT 07330912
737: 07340912
738: 41281 WRITE(NUVI,41282)IVTNUM,IVI 07350912
739: IVFAIL=IVFAIL+1 07360912
740: GO TO(33520,33540,33560,33580,33600)ISWT 07370912
741: 07380912
742: 41283 WRITE(NUVI,41284)IVTNUM,IVI 07390912
743: IVFAIL=IVFAIL+1 07400912
744: GO TO(33520,33540,33560,33580,33600)ISWT 07410912
745: 07420912
746: 41285 WRITE(NUVI,41286)IVTNUM,IVI 07430912
747: IVFAIL=IVFAIL+1 07440912
748: GO TO(33520,33540,33560,33580,33600)ISWT 07450912
749: 07460912
750: 41287 WRITE(NUVI,41288)IVTNUM,IVI 07470912
751: IVFAIL=IVFAIL+1 07480912
752: GO TO(33520,33540,33560,33580,33600)ISWT 07490912
753: 07500912
754: 41289 WRITE(NUVI,41290)IVTNUM,IVI 07510912
755: IVFAIL=IVFAIL+1 07520912
756: GO TO(33520,33540,33560,33580,33600)ISWT 07530912
757: 07540912
758: 41291 WRITE(NUVI,41292)IVTNUM,IVI 07550912
759: IVFAIL=IVFAIL+1 07560912
760: GO TO(33520,33540,33560,33580,33600)ISWT 07570912
761: 07580912
762: 41293 WRITE(NUVI,41294)IVTNUM,IVI 07590912
763: IVFAIL=IVFAIL+1 07600912
764: GO TO(33520,33540,33560,33580,33600)ISWT 07610912
765: C***** 07620912
766: C***** 07630912
767: C***** 07640912
768: 41222 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07650912
769: 1 14H - ON I FORMAT) 07660912
770: 41224 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07670912
771: 1 14H - ON F FORMAT) 07680912
772: 41226 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07690912
773: 1 14H - ON E FORMAT) 07700912
774: 41228 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07710912
775: 1 14H - ON D FORMAT) 07720912
776: 41230 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07730912
777: 1 14H - ON A FORMAT) 07740912
778: 41232 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07750912
779: 1 20H - ON X AND ' FORMAT) 07760912
780: 41234 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07770912
781: 1 14H - ON L FORMAT) 07780912
782: 41278 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07790912
783: 1 17H - ON GW.D FORMAT) 07800912
784: 41280 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07810912
785: 1 19H - ON GW.DEN FORMAT) 07820912
786: 41282 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07830912
787: 1 19H - ON BLANK RECORD ) 07840912
788: 41284 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07850912
789: 1 19H - ON SP FORMAT ) 07860912
790: 41286 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07870912
791: 1 21H - ON BZ OR SS FORMAT) 07880912
792: 41288 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07890912
793: 1 19H - ON NP FORMAT ) 07900912
794: 41290 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07910912
795: 1 19H - ON H FORMAT ) 07920912
796: 41292 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07930912
797: 1 23H - ON TR, TLC, T FORMAT) 07940912
798: 41294 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07950912
799: 1 19H - ON IN.N FORMAT ) 07960912
800: C***** 07970912
801: C***** END OF TEST SEGMENT 412 07980912
802: C***** 07990912
803: 33610 CONTINUE 08000912
804: CBB** ********************** BBCSUM0 **********************************08010912
805: C**** WRITE OUT TEST SUMMARY 08020912
806: C**** 08030912
807: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 08040912
808: WRITE (I02, 90004) 08050912
809: WRITE (I02, 90014) 08060912
810: WRITE (I02, 90004) 08070912
811: WRITE (I02, 90020) IVPASS 08080912
812: WRITE (I02, 90022) IVFAIL 08090912
813: WRITE (I02, 90024) IVDELE 08100912
814: WRITE (I02, 90026) IVINSP 08110912
815: WRITE (I02, 90028) IVTOTN, IVTOTL 08120912
816: CBE** ********************** BBCSUM0 **********************************08130912
817: CBB** ********************** BBCFOOT0 **********************************08140912
818: C**** WRITE OUT REPORT FOOTINGS 08150912
819: C**** 08160912
820: WRITE (I02,90016) ZPROG, ZPROG 08170912
821: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 08180912
822: WRITE (I02,90019) 08190912
823: CBE** ********************** BBCFOOT0 **********************************08200912
824: CBB** ********************** BBCFMT0A **********************************08210912
825: C**** FORMATS FOR TEST DETAIL LINES 08220912
826: C**** 08230912
827: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 08240912
828: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 08250912
829: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 08260912
830: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 08270912
831: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 08280912
832: 1I6,/,1H ,15X,10HCORRECT= ,I6) 08290912
833: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08300912
834: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 08310912
835: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08320912
836: 1A21,/,1H ,16X,10HCORRECT= ,A21) 08330912
837: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 08340912
838: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 08350912
839: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 08360912
840: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 08370912
841: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 08380912
842: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 08390912
843: 80050 FORMAT (1H ,48X,A31) 08400912
844: CBE** ********************** BBCFMT0A **********************************08410912
845: CBB** ********************** BBCFMAT1 **********************************08420912
846: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 08430912
847: C**** 08440912
848: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08450912
849: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 08460912
850: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 08470912
851: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 08480912
852: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 08490912
853: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 08500912
854: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 08510912
855: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 08520912
856: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08530912
857: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 08540912
858: 21H(,F12.5,2H, ,F12.5,1H)) 08550912
859: CBE** ********************** BBCFMAT1 **********************************08560912
860: CBB** ********************** BBCFMT0B **********************************08570912
861: C**** FORMAT STATEMENTS FOR PAGE HEADERS 08580912
862: C**** 08590912
863: 90002 FORMAT (1H1) 08600912
864: 90004 FORMAT (1H ) 08610912
865: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 08620912
866: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 08630912
867: 90008 FORMAT (1H ,21X,A13,A17) 08640912
868: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 08650912
869: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 08660912
870: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 08670912
871: 1 7X,7HREMARKS,24X) 08680912
872: 90014 FORMAT (1H ,46H----------------------------------------------, 08690912
873: 1 33H---------------------------------) 08700912
874: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 08710912
875: C**** 08720912
876: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 08730912
877: C**** 08740912
878: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 08750912
879: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 08760912
880: 1 A13) 08770912
881: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 08780912
882: C**** 08790912
883: C**** FORMAT STATEMENTS FOR RUN SUMMARY 08800912
884: C**** 08810912
885: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 08820912
886: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 08830912
887: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 08840912
888: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 08850912
889: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 08860912
890: CBE** ********************** BBCFMT0B **********************************08870912
891: STOP 08880912
892: END 08890912
893: C********************************************************************** 00010913
894: C DATE***82/08/02*18.33.46
895: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
896: C AUDIT FCVS78 V2.0
897: C***** FORTRAN 77 00020913
898: C***** FM913 00030913
899: C***** SN913 FAQ - (807) 00040913
900: C***** THIS SUBROUTINE IS CALLED BY PROGRAM FM912 00050913
901: C********************************************************************** 00060913
902: SUBROUTINE SN913(FW1S, GW1S, CW1B, DW1B, DW1D, BW1D, 00070913
903: 1 A20W1K, B20W1K) 00080913
904: C***** 00090913
905: C***** SUBROUTINE USED WITH SEGMENT DIRAF3 (412) TO SUPPLY VALUES 00100913
906: C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST 00110913
907: C***** 00120913
908: REAL FT1S(5),FW1S(5),GT1S(5),GW1S(5) 00130913
909: LOGICAL CT1B(5),CW1B(5),DT1B(5),DW1B(5) 00140913
910: DOUBLE PRECISION DT1D(5),DW1D(5),BT1D(5),BW1D(5) 00150913
911: CHARACTER*20 A20T1K(5),A20W1K(5),B20T1K(5),B20W1K(5) 00160913
912: DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0/ 00170913
913: DATA GT1S /1.2, 2.3, 3.5, 4.45, 45.0/ 00180913
914: DATA A20T1K / 'AAAALKJHGFASERTYUIOP', 'KDJFLKJEOITMNV E CJF', 00190913
915: 1 'CDFEJHFKLM CNB FHGDC', 'LKJHNHBJMVK,FIJ NVHD', 00200913
916: 2 'JHGFKDJJSLDKFJDKJFSL'/ 00210913
917: DATA B20T1K / 'AAAALSDEFCASERTYUIOP', 'KDDFFEJEOITMNV E CJF', 00220913
918: 1 'CDFEJHFKLM DHGDC', 'L...NHBJMVK,FIJ NVHD', 00230913
919: 2 'LKJHDNMVHNEUYHBDGHCJ'/ 00240913
920: DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .FALSE./ 00250913
921: DATA DT1B /.FALSE., .TRUE., .FALSE., .TRUE., .TRUE./ 00260913
922: DATA DT1D /1.23D1, 2.34D1, 3.45D3, 5.602D3, 5.602D0/ 00270913
923: DATA BT1D /23.1D1, 34.1D1, 23.45D3, .625D0, 109.384D0/ 00280913
924: C***** 00290913
925: C***** 00300913
926: C***** 00310913
927: DO 1 IVI = 1, 5 00320913
928: FW1S(IVI) = FT1S(IVI) 00330913
929: GW1S(IVI) = GT1S(IVI) 00340913
930: CW1B(IVI) = CT1B(IVI) 00350913
931: DW1B(IVI) = DT1B(IVI) 00360913
932: DW1D(IVI) = DT1D(IVI) 00370913
933: BW1D(IVI) = BT1D(IVI) 00380913
934: A20W1K(IVI) = A20T1K(IVI) 00390913
935: B20W1K(IVI) = B20T1K(IVI) 00400913
936: 1 CONTINUE 00410913
937: C***** 00420913
938: C***** 00430913
939: C***** 00440913
940: RETURN 00450913
941: END 00460913
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.