![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM910.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 FM910.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***********************************************************************00010910
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***** FM910 00020910
6: C***** DIRAF2 - (411) 00030910
7: C***** THIS PROGRAM CALLS SUBROUTINE SN911 IN FILE FM911 00040910
8: C***********************************************************************00050910
9: C***** TESTING OF DIRECT ACCESS FILES ANS REF 00060910
10: C***** UNFORMATTED WITH BOTH SEQUENTIAL AND DIRECT 12.5 00070910
11: C***** ACCESS TO THE SAME FILE 00080910
12: C***** NAMED FILE AND SCRATCH FILE 00090910
13: C***** 00100910
14: C***** USES SUBROUTINE SN911 00110910
15: C***** 00120910
16: CBB** ********************** BBCCOMNT **********************************00130910
17: C**** 00140910
18: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150910
19: C**** VERSION 2.0 00160910
20: C**** 00170910
21: C**** 00180910
22: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190910
23: C**** GENERAL SERVICES ADMINISTRATION 00200910
24: C**** FEDERAL SOFTWARE TESTING CENTER 00210910
25: C**** 5203 LEESBURG PIKE, SUITE 1100 00220910
26: C**** FALLS CHURCH, VA. 22041 00230910
27: C**** 00240910
28: C**** (703) 756-6153 00250910
29: C**** 00260910
30: CBE** ********************** BBCCOMNT **********************************00270910
31: C***** 00280910
32: C***** S P E C I F I C A T I O N S SEGMENT 910 00290910
33: DIMENSION L1I(10), N1I(15), F1S(10), H1S(15) 00300910
34: CHARACTER*4 A4VK, B4VK, D4VK, A41K(10), C41K(15) 00310910
35: LOGICAL AVB, BVB, C1B(10), E1B(15) 00320910
36: DOUBLE PRECISION AVD, BVD, D1D(10), B1D(15) 00330910
37: COMPLEX AVC, BVC, C1C(10), D1C(15) 00340910
38: C***** 00350910
39: C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00360910
40: CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING 00370910
41: CHARACTER*15 CDIR 00380910
42: C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-100 00390910
43: C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR. 00400910
44: CBB** ********************** BBCINITA **********************************00410910
45: C**** SPECIFICATION STATEMENTS 00420910
46: C**** 00430910
47: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00440910
48: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00450910
49: CBE** ********************** BBCINITA **********************************00460910
50: CBB** ********************** BBCINITB **********************************00470910
51: C**** INITIALIZE SECTION 00480910
52: DATA ZVERS, ZVERSD, ZDATE 00490910
53: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00500910
54: DATA ZCOMPL, ZNAME, ZTAPE 00510910
55: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00520910
56: DATA ZPROJ, ZTAPED, ZPROG 00530910
57: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00540910
58: DATA REMRKS /' '/ 00550910
59: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00560910
60: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00570910
61: C**** 00580910
62: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00590910
63: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00600910
64: CZ03 ZPROG = 'PROGRAM NAME' 00610910
65: ZDATE = '07-Nov-85 ' *RP
66: ZCOMPL = 'CCI 5.2 ' *RP
67: ZPROJ = 'TC-85- -410' *RP
68: ZNAME = ' ' *RP
69: ZTAPE = ' ' *RP
70: ZTAPED = '850703 ' *RP
71: C 00680910
72: IVPASS = 0 00690910
73: IVFAIL = 0 00700910
74: IVDELE = 0 00710910
75: IVINSP = 0 00720910
76: IVTOTL = 0 00730910
77: IVTOTN = 0 00740910
78: ICZERO = 0 00750910
79: C 00760910
80: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00770910
81: I01 = 05 00780910
82: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00790910
83: I02 = 06 00800910
84: C 00810910
85: I01 = 5 00820910
86: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00830910
87: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00840910
88: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00850910
89: C 00860910
90: I02 = 6 00870910
91: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00880910
92: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00890910
93: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00900910
94: C 00910910
95: CBE** ********************** BBCINITB **********************************00920910
96: C***** 00930910
97: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE 00940910
98: C***** UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED. 00950910
99: C***** 00960910
100: C I10 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE. 00970910
101: I10 = 24 00980910
102: OPEN(UNIT=I10,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=80) 00990910
103: C SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24. 01000910
104: C***** 01010910
105: C I11 CONTAINS THE UNIT NUMBER FOR A SCRATCH DIRECT ACCESS FILE. 01020910
106: I11 = 25 01030910
107: OPEN(UNIT=I11,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=80) 01040910
108: C SPECIFYING I11 = NN OVERRIDES THE DEFAULT I11 = 25. 01050910
109: C***** 01060910
110: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 01070910
111: C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 01080910
112: C***** UNFORMATTED FILE. 01090910
113: C***** 01100910
114: C CDIR CONTAINS THE FILE NAME FOR UNIT I10. 01110910
115: CDIR = ' DIRFILE' 01120910
116: C 01130910
117: CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS 01140910
118: C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH 01150910
119: C X-100 THAN THE DEFAULT CDIR = ' DIRFILE'. 01160910
120: C***** FILE NUMBER AND NAME ASSIGNMENT 01170910
121: NUVI = I02 01180910
122: IMVI = I10 01190910
123: KMVI = I11 01200910
124: IVTOTL = 6 01210910
125: ZPROG = 'FM910' 01220910
126: CBB** ********************** BBCHED0A **********************************01230910
127: C**** 01240910
128: C**** WRITE REPORT TITLE 01250910
129: C**** 01260910
130: WRITE (I02, 90002) 01270910
131: WRITE (I02, 90006) 01280910
132: WRITE (I02, 90007) 01290910
133: WRITE (I02, 90008) ZVERS, ZVERSD 01300910
134: WRITE (I02, 90009) ZPROG, ZPROG 01310910
135: WRITE (I02, 90010) ZDATE, ZCOMPL 01320910
136: CBE** ********************** BBCHED0A **********************************01330910
137: C***** 01340910
138: C***** HEADER FOR SEGMENT 910 01350910
139: WRITE(NUVI,41100) 01360910
140: 41100 FORMAT(1H ,/46H DIRAF2 - (411) DIRECT ACCESS UNFORMATTED FILE// 01370910
141: 1 41H WITH OPTION TO OPEN AS A SEQUENTIAL FILE// 01380910
142: 2 16H ANS REF. - 12.5) 01390910
143: CBB** ********************** BBCHED0B **********************************01400910
144: C**** WRITE DETAIL REPORT HEADERS 01410910
145: C**** 01420910
146: WRITE (I02,90004) 01430910
147: WRITE (I02,90004) 01440910
148: WRITE (I02,90013) 01450910
149: WRITE (I02,90014) 01460910
150: WRITE (I02,90015) IVTOTL 01470910
151: CBE** ********************** BBCHED0B **********************************01480910
152: C***** INITIALIZE DATA 01490910
153: CALL SN911(L1I,N1I,F1S,H1S,C1B,E1B,D1D,B1D,C1C,D1C,A41K,C41K) 01500910
154: MMVI = 0 01510910
155: C***** 01520910
156: OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT',RECL=132, 01530910
157: 1 STATUS='NEW') 01540910
158: C***** WRITE DIRECT FILE IN SEQUENTIAL ORDER 01550910
159: DO 41101 IVI = 1,10 01560910
160: AVS = F1S (IVI) 01570910
161: A4VK = A41K (IVI) 01580910
162: AVB = C1B (IVI) 01590910
163: AVD = D1D (IVI) 01600910
164: AVC = C1C (IVI) 01610910
165: WRITE(UNIT=IMVI, REC= IVI) IVI, AVS, A4VK, AVB, AVD, AVC 01620910
166: 41101 CONTINUE 01630910
167: C***** CHECK TO SEE IF IT CAN BE OPEN SEQUENTIAL 01640910
168: INQUIRE(UNIT=IMVI,SEQUENTIAL=D4VK) 01650910
169: CLOSE(UNIT=IMVI) 01660910
170: IF(D4VK .EQ. 'YES ') GOTO 41103 01670910
171: WRITE(NUVI,41102) 01680910
172: 41102 FORMAT(1H ,48X,31HTESTS 2 THRU 6 ARE EXPECTED TO / 01690910
173: 1 1H ,48X,31HEXECUTE / 01700910
174: 2 1H ,48X,31HTEST 1 IS OPTIONAL AND IS NOT / 01710910
175: 3 1H ,48X,31HEXECUTED IF DIRECT ACCESS / 01720910
176: 4 1H ,48X,31HFILE CANNOT BE REOPENED AS / 01730910
177: 5 1H ,48X,31HA SEQUENTIAL FILE ) 01740910
178: GOTO 41119 01750910
179: CT001* TEST 1 READ IT SEQUENTIALY 01760910
180: 41103 IVTNUM = 1 01770910
181: IVCOMP = 0 01780910
182: OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='SEQUENTIAL', STATUS='OLD', 01790910
183: 1 FORM='UNFORMATTED') 01800910
184: REWIND(UNIT=IMVI) 01810910
185: DO 41104 IVI = 1, 10 01820910
186: READ(UNIT=IMVI) KVI, BVS, B4VK, BVB, BVD, BVC 01830910
187: IF (IVI .NE. KVI) GOTO 20010 01840910
188: IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20010 01850910
189: IF (B4VK .NE. A41K(IVI)) GOTO 20010 01860910
190: IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 01870910
191: 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20010 01880910
192: IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20010 01890910
193: IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT. 01900910
194: 1 REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI))) 01910910
195: 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20010 01920910
196: GO TO 41104 01930910
197: 20010 IVCOMP = IVCOMP + 1 01940910
198: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 01950910
199: WRITE (NUVI, 70010) IVTNUM, IVI 01960910
200: WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI, 01970910
201: 1 F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI), 01980910
202: 1 C1C(IVI) 01990910
203: 70010 FORMAT (1H ,2X,I3,4X,13H FAIL ON REC ,I2) 02000910
204: 70020 FORMAT (1H ,16X,10HCOMPUTED: ,I2,1X,F5.2,1X,A4,1X,L1,1X, 02010910
205: 1 D10.3,1X,1H(,F6.3,2H, ,F6.3,1H)/02020910
206: 1 1H ,16X,10HCORRECT: ,I2,1X,F5.2,1X,A4,1X,L1,1X, 02030910
207: 1 D10.3,1X,1H(,F6.3,2H, ,F6.3,1H))02040910
208: 41104 CONTINUE 02050910
209: IF (IVCOMP - 0) 0011, 10010, 0011 02060910
210: 10010 IVPASS = IVPASS + 1 02070910
211: WRITE (NUVI, 80002) IVTNUM 02080910
212: 0011 CONTINUE 02090910
213: C***** 02100910
214: 41118 CLOSE(UNIT=IMVI) 02110910
215: CT002* TEST 2 REOPEN AS DIRECT FILE, 02120910
216: C***** AND READ IN SEQUENTIAL ORDER 02130910
217: 41119 IVTNUM = 2 02140910
218: IVCOMP = 0 02150910
219: C***** 02160910
220: OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD', 02170910
221: 1 RECL=132) 02180910
222: DO 41120 IVI = 1, 10 02190910
223: READ(UNIT=IMVI, REC = IVI) KVI, BVS, B4VK, BVB, BVD, BVC 02200910
224: IF (IVI .NE. KVI) GOTO 20020 02210910
225: IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20020 02220910
226: IF (B4VK .NE. A41K(IVI)) GOTO 20020 02230910
227: IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 02240910
228: 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20020 02250910
229: IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20020 02260910
230: IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT. 02270910
231: 1 REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI))) 02280910
232: 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20020 02290910
233: GO TO 41120 02300910
234: 20020 IVCOMP = IVCOMP + 1 02310910
235: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 02320910
236: WRITE (NUVI, 70010) IVTNUM, IVI 02330910
237: WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI, 02340910
238: 1 F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI), 02350910
239: 1 C1C(IVI) 02360910
240: 41120 CONTINUE 02370910
241: IF (IVCOMP - 0) 0021, 10020, 0021 02380910
242: 10020 IVPASS = IVPASS + 1 02390910
243: WRITE (NUVI, 80002) IVTNUM 02400910
244: 0021 CONTINUE 02410910
245: C***** 02420910
246: 41121 CLOSE(UNIT=IMVI) 02430910
247: CT003* TEST 3 READ IT AS DIRECT 02440910
248: C***** FILE IN NONSEQUENTIAL ORDER 02450910
249: IVTNUM = 3 02460910
250: IVCOMP = 0 02470910
251: C***** 02480910
252: OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD', 02490910
253: 1 RECL=132) 02500910
254: DO 41122 IVI = 1, 10 02510910
255: JVI = L1I(IVI) 02520910
256: READ(UNIT=IMVI, REC = JVI) KVI, BVS, B4VK, BVB, BVD, BVC 02530910
257: IF (KVI .NE. JVI) GOTO 20030 02540910
258: IF (BVS .LT. F1S(JVI) .OR. BVS .GT. F1S(JVI)) GOTO 20030 02550910
259: IF (B4VK .NE. A41K(JVI)) GOTO 20030 02560910
260: IF ((BVB .AND. .NOT. C1B(JVI)) .OR. 02570910
261: 1 (.NOT. BVB .AND. C1B(JVI))) GOTO 20030 02580910
262: IF (BVD .LT. D1D(JVI) .OR. BVD .GT. D1D(JVI)) GOTO 20030 02590910
263: IF ((REAL(BVC) .LT. REAL(C1C(JVI))) .OR. (REAL(BVC) .GT. 02600910
264: 1 REAL(C1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(JVI))) 02610910
265: 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(JVI)))) GOTO 20030 02620910
266: GO TO 41122 02630910
267: 20030 IVCOMP = IVCOMP + 1 02640910
268: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 02650910
269: WRITE (NUVI, 70010) IVTNUM, JVI 02660910
270: WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI, 02670910
271: 1 F1S(JVI), A41K(JVI), C1B(JVI), D1D(JVI), 02680910
272: 1 C1C(JVI) 02690910
273: 41122 CONTINUE 02700910
274: IF (IVCOMP - 0) 0031, 10030, 0031 02710910
275: 10030 IVPASS = IVPASS + 1 02720910
276: WRITE (NUVI, 80002) IVTNUM 02730910
277: 0031 CONTINUE 02740910
278: C***** 02750910
279: 41123 OPEN(UNIT=KMVI, ACCESS='DIRECT', RECL=80, STATUS='SCRATCH') 02760910
280: C***** 02770910
281: CT004* TEST 4 CHECK RECL AND NEXTREC ON SCRATCH FILE 02780910
282: IVTNUM = 4 02790910
283: INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI) 02800910
284: IF (IVI .NE. 80) GOTO 20040 02810910
285: IF (KVI .NE. 1) GOTO 20040 02820910
286: 10040 IVPASS = IVPASS + 1 02830910
287: WRITE (NUVI, 80002) IVTNUM 02840910
288: GO TO 0041 02850910
289: 20040 IVFAIL = IVFAIL + 1 02860910
290: WRITE (NUVI, 70030) IVTNUM 02870910
291: WRITE (NUVI, 70040) IVI, KVI 02880910
292: 70030 FORMAT (1H ,2X,I3,4X,28H FAIL ON RECL AND/OR NEXTREC) 02890910
293: 70040 FORMAT (1H ,16X,16HCOMPUTED: RECL=,I4,10H, NEXTREC=,I4/ 02900910
294: 1 1H ,16X,34HCORRECT: RECL= 80, NEXTREC= 1) 02910910
295: 0041 CONTINUE 02920910
296: C***** 02930910
297: C***** WRITE DIRECT ACCESS 02940910
298: C***** SCRATCH FILE IN NONSEQUENTIAL ORDER 02950910
299: DO 41126 IVI = 1,15 02960910
300: JVI = N1I (IVI) 02970910
301: AVS = H1S (JVI) 02980910
302: A4VK = C41K (JVI) 02990910
303: AVB = E1B (JVI) 03000910
304: AVC = D1C(JVI) 03010910
305: AVD = B1D(JVI) 03020910
306: WRITE(UNIT=KMVI, REC= JVI) AVB, AVC, A4VK, JVI, AVD, AVS 03030910
307: 41126 CONTINUE 03040910
308: CT005* TEST 5 CHECK DIRECT ACCESS SCRATCH FILE 03050910
309: C***** BY READING IT IN NONSEQUENTIAL ORDER 03060910
310: IVTNUM = 5 03070910
311: IVCOMP = 0 03080910
312: MMVI = -1 03090910
313: DO 41127 IVI = 15,1,-1 03100910
314: JVI = N1I (IVI) 03110910
315: READ(UNIT=KMVI, REC = JVI) BVB, BVC, B4VK, KVI, BVD, BVS 03120910
316: IF (KVI .NE. JVI) GOTO 20050 03130910
317: IF (BVS .LT. H1S(JVI) .OR. BVS .GT. H1S(JVI)) GOTO 20050 03140910
318: IF (B4VK .NE. C41K(JVI)) GOTO 20050 03150910
319: IF ((BVB .AND. .NOT. E1B(JVI)) .OR. 03160910
320: 1 (.NOT. BVB .AND. E1B(JVI))) GOTO 20050 03170910
321: IF (BVD .LT. B1D(JVI) .OR. BVD .GT. B1D(JVI)) GOTO 20050 03180910
322: IF ((REAL(BVC) .LT. REAL(D1C(JVI))) .OR. (REAL(BVC) .GT. 03190910
323: 1 REAL(D1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(D1C(JVI))) 03200910
324: 2 .OR. (AIMAG(BVC) .GT. AIMAG(D1C(JVI)))) GOTO 20050 03210910
325: GO TO 41127 03220910
326: 20050 IVCOMP = IVCOMP + 1 03230910
327: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 03240910
328: WRITE (NUVI, 70010) IVTNUM, JVI 03250910
329: WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI, 03260910
330: 1 H1S(JVI), C41K(JVI), E1B(JVI), B1D(JVI), 03270910
331: 1 D1C(JVI) 03280910
332: 41127 CONTINUE 03290910
333: IF (IVCOMP - 0) 0051, 10050, 0051 03300910
334: 10050 IVPASS = IVPASS + 1 03310910
335: WRITE (NUVI, 80002) IVTNUM 03320910
336: 0051 CONTINUE 03330910
337: C***** 03340910
338: CT006* TEST 6 CHECK RECL AND NEXTREC AFTER READING 03350910
339: IVTNUM = 6 03360910
340: INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI) 03370910
341: IF (IVI .NE. 80) GOTO 20060 03380910
342: IF (KVI .NE. 6) GOTO 20060 03390910
343: 10060 IVPASS = IVPASS + 1 03400910
344: WRITE (NUVI, 80002) IVTNUM 03410910
345: GO TO 0061 03420910
346: 20060 IVFAIL = IVFAIL + 1 03430910
347: WRITE (NUVI, 70050) IVTNUM 03440910
348: WRITE (NUVI, 70060) IVI, KVI 03450910
349: 70050 FORMAT (1H ,2X,I3,4X,28H FAIL ON RECL AND/OR NEXTREC) 03460910
350: 70060 FORMAT (1H ,16X,16HCOMPUTED: RECL=,I4,10H, NEXTREC=,I4/ 03470910
351: 1 1H ,16X,34HCORRECT: RECL= 80, NEXTREC= 6) 03480910
352: 0061 CONTINUE 03490910
353: C***** 03500910
354: CLOSE (UNIT=IMVI,STATUS='DELETE') 03510*TI
355: C***** 03520910
356: C**** 04070910
357: CBB** ********************** BBCSUM0 **********************************04080910
358: C**** WRITE OUT TEST SUMMARY 04090910
359: C**** 04100910
360: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04110910
361: WRITE (I02, 90004) 04120910
362: WRITE (I02, 90014) 04130910
363: WRITE (I02, 90004) 04140910
364: WRITE (I02, 90020) IVPASS 04150910
365: WRITE (I02, 90022) IVFAIL 04160910
366: WRITE (I02, 90024) IVDELE 04170910
367: WRITE (I02, 90026) IVINSP 04180910
368: WRITE (I02, 90028) IVTOTN, IVTOTL 04190910
369: CBE** ********************** BBCSUM0 **********************************04200910
370: CBB** ********************** BBCFOOT0 **********************************04210910
371: C**** WRITE OUT REPORT FOOTINGS 04220910
372: C**** 04230910
373: WRITE (I02,90016) ZPROG, ZPROG 04240910
374: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04250910
375: WRITE (I02,90019) 04260910
376: CBE** ********************** BBCFOOT0 **********************************04270910
377: CBB** ********************** BBCFMT0A **********************************04280910
378: C**** FORMATS FOR TEST DETAIL LINES 04290910
379: C**** 04300910
380: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 04310910
381: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 04320910
382: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 04330910
383: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 04340910
384: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 04350910
385: 1I6,/,1H ,15X,10HCORRECT= ,I6) 04360910
386: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04370910
387: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 04380910
388: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04390910
389: 1A21,/,1H ,16X,10HCORRECT= ,A21) 04400910
390: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 04410910
391: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 04420910
392: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 04430910
393: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 04440910
394: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 04450910
395: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 04460910
396: 80050 FORMAT (1H ,48X,A31) 04470910
397: CBE** ********************** BBCFMT0A **********************************04480910
398: CBB** ********************** BBCFMAT1 **********************************04490910
399: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04500910
400: C**** 04510910
401: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04520910
402: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 04530910
403: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 04540910
404: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 04550910
405: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04560910
406: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04570910
407: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04580910
408: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04590910
409: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04600910
410: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 04610910
411: 21H(,F12.5,2H, ,F12.5,1H)) 04620910
412: CBE** ********************** BBCFMAT1 **********************************04630910
413: CBB** ********************** BBCFMT0B **********************************04640910
414: C**** FORMAT STATEMENTS FOR PAGE HEADERS 04650910
415: C**** 04660910
416: 90002 FORMAT (1H1) 04670910
417: 90004 FORMAT (1H ) 04680910
418: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 04690910
419: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04700910
420: 90008 FORMAT (1H ,21X,A13,A17) 04710910
421: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 04720910
422: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 04730910
423: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 04740910
424: 1 7X,7HREMARKS,24X) 04750910
425: 90014 FORMAT (1H ,46H----------------------------------------------, 04760910
426: 1 33H---------------------------------) 04770910
427: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 04780910
428: C**** 04790910
429: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04800910
430: C**** 04810910
431: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 04820910
432: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 04830910
433: 1 A13) 04840910
434: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 04850910
435: C**** 04860910
436: C**** FORMAT STATEMENTS FOR RUN SUMMARY 04870910
437: C**** 04880910
438: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 04890910
439: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 04900910
440: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 04910910
441: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 04920910
442: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 04930910
443: CBE** ********************** BBCFMT0B **********************************04940910
444: C***** 04950910
445: C***** END OF TEST SEGMENT 910 04960910
446: STOP 04970910
447: END 04980910
448: C********************************************************************** 00010911
449: C DATE***82/08/02*18.33.46
450: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
451: C AUDIT FCVS78 V2.0
452: C***** FM911 00020911
453: C***** 00030911
454: C***** SN911 EAQ - (806) 00040911
455: C***** THIS SUBROUTINE IS CALLED BY FM910 00050911
456: C********************************************************************** 00060911
457: SUBROUTINE SN911(LW1I, NW1I, FW1S, HW1S, CW1B, EW1B, DW1D, 00070911
458: 1 BW1D,CW1C, DW1C, A4W1K, C4W1K) 00080911
459: C***** 00090911
460: C***** SUBROUTINE USED WITH SEGMENT DIRAF2 (411) TO SUPPLY VALUES 00100911
461: C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST 00110911
462: C***** 00120911
463: DIMENSION LW1I(10),LT1I(10),NT1I(15),NW1I(15) 00130911
464: REAL FT1S(10),FW1S(10),HT1S(15),HW1S(15) 00140911
465: LOGICAL CT1B(10),CW1B(10),ET1B(15),EW1B(15) 00150911
466: DOUBLE PRECISION DT1D(10),DW1D(10),BT1D(15),BW1D(15) 00160911
467: COMPLEX CW1C(10),CT1C(10),DW1C(15),DT1C(15) 00170911
468: CHARACTER*4 A4T1K(10),A4W1K(10),C4T1K(15),C4W1K(15) 00180911
469: C***** 00190911
470: DATA LT1I /2, 3, 1, 3, 10, 8, 9, 6, 7, 5/ 00200911
471: DATA NT1I /5, 7, 3, 9, 4, 11, 8, 13, 14, 12, 6, 10, 2, 15, 1/ 00210911
472: DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0, 6.5, 7.1, 8.2, 9.9, 10.0/ 00220911
473: DATA HT1S /2.34, 2.3,1.9, 2.3, 9.9, 1.1, 8.8, 7.6, 2.3, 10.1, 00230911
474: 1 3.4, 5.60, 34.9, 3.48, 23.8/ 00240911
475: DATA A4T1K / 'AAAA', 'BBBB', 'CCCC', 'DDDD', 'EDFG', 'JLKD'00250911
476: 1 , 'CDFE', 'LKJH', 'JHGF', 'LLLL'/ 00260911
477: DATA C4T1K / 'HDFK', 'LKJH', 'ASDF', 'LKJH', 'XMNC', 'ALXM'00270911
478: 1 , 'IEOW', 'IERU', 'DJNC', 'DJAL', 'KDFJ', 'ABCD'00280911
479: 2 , 'ASDF', 'GHJK', 'QWER'/ 00290911
480: DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .TRUE., .FALSE., 00300911
481: 1 .FALSE., .TRUE., .TRUE., .FALSE./ 00310911
482: DATA ET1B /.FALSE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE., 00320911
483: 1 .TRUE., .TRUE., .FALSE., .TRUE., .TRUE., .TRUE., 00330911
484: 2 .FALSE., .TRUE., .FALSE./ 00340911
485: DATA DT1D /1.23D1, 2.34D1, 3.45D3, 4.56D4, 5.602D0, 34.35D1, 00350911
486: 1 2.34D1, 398.0D0, 3.49D-1, 0.99D1/ 00360911
487: DATA BT1D /3.45D1, 34.5D0, 34.5D4, 2.93D3, 0.09D-2, 3.4D-1, 00370911
488: 1 34.0D1, 85.0D1, 3.968D0, 3.48D1, 39.3D4, 0.09D3, 00380911
489: 2 389.098D1, 483.98D0, 3456.0D-4/ 00390911
490: DATA CT1C /(1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9), 00400911
491: 1 (2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2), 00410911
492: 2 (2.56, 2.1), (3.4, 4.5)/ 00420911
493: DATA DT1C /(2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2), 00430911
494: 1 (2.56, 2.1), (3.4, 4.5), (3.4, 34.9), (9.0, 34.9), 00440911
495: 2 (1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9), 00450911
496: 3 (3.112, 3.4), (8.0, 1.2), (3.112, 3.4)/ 00460911
497: 00470911
498: C***** 00480911
499: DO 1 IVI = 1, 10 00490911
500: LW1I(IVI) = LT1I(IVI) 00500911
501: FW1S(IVI) = FT1S(IVI) 00510911
502: CW1B(IVI) = CT1B(IVI) 00520911
503: DW1D(IVI) = DT1D(IVI) 00530911
504: CW1C(IVI) = CT1C(IVI) 00540911
505: A4W1K(IVI) = A4T1K(IVI) 00550911
506: 1 CONTINUE 00560911
507: C***** 00570911
508: DO 2 IVI = 1, 15 00580911
509: NW1I(IVI) = NT1I(IVI) 00590911
510: HW1S(IVI) = HT1S(IVI) 00600911
511: EW1B(IVI) = ET1B(IVI) 00610911
512: BW1D(IVI) = BT1D(IVI) 00620911
513: DW1C(IVI) = DT1C(IVI) 00630911
514: C4W1K(IVI) = C4T1K(IVI) 00640911
515: 2 CONTINUE 00650911
516: C***** 00660911
517: RETURN 00670911
518: END 00680911
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.