|
|
1.1 root 1: PROGRAM FM701 00010701
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 00020701
6: C THIS ROUTINE TESTS ARRAY DECLARATORS WHERE DIMENSION ANS REF.00030701
7: C BOUND EXPRESSIONS MAY CONTAIN CONSTANTS, 5.1.1.2 00040701
8: C SYMBOLIC NAMES OF CONSTANTS, OR VARIABLES 5.1.1 00050701
9: C OF TYPE INTEGER. 00060701
10: C 00070701
11: C THIS ROUTINE USES ROUTINES 602 THROUGH 609 AS SUBROUTINES. 00080701
12: C 00090701
13: C 00100701
14: CBB** ********************** BBCCOMNT **********************************00110701
15: C**** 00120701
16: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130701
17: C**** VERSION 2.0 00140701
18: C**** 00150701
19: C**** 00160701
20: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170701
21: C**** GENERAL SERVICES ADMINISTRATION 00180701
22: C**** FEDERAL SOFTWARE TESTING CENTER 00190701
23: C**** 5203 LEESBURG PIKE, SUITE 1100 00200701
24: C**** FALLS CHURCH, VA. 22041 00210701
25: C**** 00220701
26: C**** (703) 756-6153 00230701
27: C**** 00240701
28: CBE** ********************** BBCCOMNT **********************************00250701
29: IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00260701
30: IMPLICIT CHARACTER*27 (C) 00270701
31: CBB** ********************** BBCINITA **********************************00280701
32: C**** SPECIFICATION STATEMENTS 00290701
33: C**** 00300701
34: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00310701
35: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00320701
36: CBE** ********************** BBCINITA **********************************00330701
37: C 00340701
38: INTEGER I2D001(3,5), I2D002(2,4), I2D003(5,2) 00350701
39: PARAMETER (IPN001=1, IPN002=-1, IPN003=4) 00360701
40: DIMENSION I2N004(IPN001:2,3), I2N005(2,-1:IPN001), 00370701
41: 1 I2N006(IPN002:IPN001,1:IPN003) 00380701
42: DIMENSION I2N007(+5:7,+1:2), I2N008(0:2,2), I2N009(1:3,-1:1), 00390701
43: 1 I2N010(4,2), I2N011(2*2+1:7,1:2) 00400701
44: DIMENSION I2N012(1:+2,2:+4), I2N013(-2:0,2), I2D014(1:3,-3:-1), 00410701
45: 1 I2N015(1:2*2+1,1:2), I2N016(2,6/3-1:2*5-7) 00420701
46: CHARACTER*4 CVCOMP, CVCORR 00430701
47: CHARACTER*4 C2N001(0:5,1:6), C2D002(2,1:3), C2N003(-2:1,3:10), 00440701
48: 1 C2D004(1:2,5:7), C1N005(+1:6),C3D006(1:2,2,5:7) 00450701
49: DATA I2D001 / 12*0, -47, 2*0 / 00460701
50: DATA I2D002 / 6*0, 5, 0 / 00470701
51: DATA I2D003 / 6, 8*0, -11 / 00480701
52: DATA I2N004 / -4, 5*4 / 00490701
53: DATA I2N005 / -5, 5*5 / 00500701
54: DATA I2N006 / 6*6, -6, 5*6 / 00510701
55: DATA I2N007 / 3*7, -7, 2*7 / 00520701
56: DATA I2N008 / -8, 5*8 / 00530701
57: DATA I2N009 / 2*9, -9, 6*9 / 00540701
58: DATA I2N010 / -10, 7*10 / 00550701
59: DATA I2N011 / 3*11, -11, 2*11 / 00560701
60: DATA I2N012 / 7, 5*-7 / 00570701
61: DATA I2N013 / 8, 5*-8 / 00580701
62: DATA I2D014 / 9, 8*-9 / 00590701
63: DATA I2N015 / 9*-10, 10 / 00600701
64: DATA I2N016 / 11, 4*-11, -10 / 00610701
65: DATA C2N001 / 'C001', 35*' ' / 00620701
66: DATA C2D002 / 5*' ', 'C002' / 00630701
67: DATA C2N003 / 'C003', 31*' ' / 00640701
68: DATA C2D004 / 'C004', 5*' ' / 00650701
69: DATA C1N005 / 'C005', 5*' ' / 00660701
70: DATA C3D006 / 'C006', 11*' ' / 00670701
71: C 00680701
72: C 00690701
73: CBB** ********************** BBCINITB **********************************00700701
74: C**** INITIALIZE SECTION 00710701
75: DATA ZVERS, ZVERSD, ZDATE 00720701
76: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00730701
77: DATA ZCOMPL, ZNAME, ZTAPE 00740701
78: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00750701
79: DATA ZPROJ, ZTAPED, ZPROG 00760701
80: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00770701
81: DATA REMRKS /' '/ 00780701
82: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00790701
83: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00800701
84: C**** 00810701
85: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00820701
86: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00830701
87: CZ03 ZPROG = 'PROGRAM NAME' 00840701
88: ZDATE = '07-Nov-85 ' *RP
89: ZCOMPL = 'CCI 5.2 ' *RP
90: ZPROJ = 'TC-85- -410' *RP
91: ZNAME = ' ' *RP
92: ZTAPE = ' ' *RP
93: ZTAPED = '850703 ' *RP
94: C 00910701
95: IVPASS = 0 00920701
96: IVFAIL = 0 00930701
97: IVDELE = 0 00940701
98: IVINSP = 0 00950701
99: IVTOTL = 0 00960701
100: IVTOTN = 0 00970701
101: ICZERO = 0 00980701
102: C 00990701
103: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 01000701
104: I01 = 05 01010701
105: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01020701
106: I02 = 06 01030701
107: C 01040701
108: I01 = 5 01050701
109: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01060701
110: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01070701
111: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01080701
112: C 01090701
113: I02 = 6 01100701
114: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01110701
115: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01120701
116: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01130701
117: C 01140701
118: CBE** ********************** BBCINITB **********************************01150701
119: ZPROG='FM701' 01160701
120: IVTOTL = 35 01170701
121: CBB** ********************** BBCHED0A **********************************01180701
122: C**** 01190701
123: C**** WRITE REPORT TITLE 01200701
124: C**** 01210701
125: WRITE (I02, 90002) 01220701
126: WRITE (I02, 90006) 01230701
127: WRITE (I02, 90007) 01240701
128: WRITE (I02, 90008) ZVERS, ZVERSD 01250701
129: WRITE (I02, 90009) ZPROG, ZPROG 01260701
130: WRITE (I02, 90010) ZDATE, ZCOMPL 01270701
131: CBE** ********************** BBCHED0A **********************************01280701
132: CBB** ********************** BBCHED0B **********************************01290701
133: C**** WRITE DETAIL REPORT HEADERS 01300701
134: C**** 01310701
135: WRITE (I02,90004) 01320701
136: WRITE (I02,90004) 01330701
137: WRITE (I02,90013) 01340701
138: WRITE (I02,90014) 01350701
139: WRITE (I02,90015) IVTOTL 01360701
140: CBE** ********************** BBCHED0B **********************************01370701
141: C 01380701
142: C TESTS 1-3 - LOWER AND/OR UPPER BOUNDS ARE ARITHMETIC EXPRESSIONS 01390701
143: C OF TYPE INTEGER, USING VARIABLES 01400701
144: C 01410701
145: C 01420701
146: CT001* TEST 001 **** FCVS PROGRAM 701 **** 01430701
147: C 01440701
148: C TEST 001 LOWER BOUND 01450701
149: C 01460701
150: IVTNUM = 1 01470701
151: IVCORR = -47 01480701
152: CALL SN702(1,1,2,6,I2D001,I2D002,I2D003,IVCOMP) 01490701
153: 40010 IF (IVCOMP + 47) 20010, 10010, 20010 01500701
154: 10010 IVPASS = IVPASS + 1 01510701
155: WRITE (I02,80002) IVTNUM 01520701
156: GO TO 0011 01530701
157: 20010 IVFAIL = IVFAIL + 1 01540701
158: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01550701
159: 0011 CONTINUE 01560701
160: C 01570701
161: CT002* TEST 002 **** FCVS PROGRAM 701 **** 01580701
162: C 01590701
163: C TEST 002 UPPER BOUND 01600701
164: C 01610701
165: IVTNUM = 2 01620701
166: IVCORR = 5 01630701
167: CALL SN702(2,1,2,6,I2D001,I2D002,I2D003,IVCOMP) 01640701
168: 40020 IF (IVCOMP - 5) 20020, 10020, 20020 01650701
169: 10020 IVPASS = IVPASS + 1 01660701
170: WRITE (I02,80002) IVTNUM 01670701
171: GO TO 0021 01680701
172: 20020 IVFAIL = IVFAIL + 1 01690701
173: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01700701
174: 0021 CONTINUE 01710701
175: C 01720701
176: CT003* TEST 003 **** FCVS PROGRAM 701 **** 01730701
177: C 01740701
178: C TEST 003 BOTH LOWER AND UPPER BOUNDS 01750701
179: C 01760701
180: IVTNUM = 3 01770701
181: IVCORR = 17 01780701
182: CALL SN702(3,1,2,6,I2D001,I2D002,I2D003,IVCOMP) 01790701
183: 40030 IF (IVCOMP - 17) 20030, 10030, 20030 01800701
184: 10030 IVPASS = IVPASS + 1 01810701
185: WRITE (I02,80002) IVTNUM 01820701
186: GO TO 0031 01830701
187: 20030 IVFAIL = IVFAIL + 1 01840701
188: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01850701
189: 0031 CONTINUE 01860701
190: C 01870701
191: C TESTS 4-6 - LOWER AND/OR UPPER BOUNDS ARE SYMBOLIC NAMES 01880701
192: C OF INTEGER CONSTANTS 01890701
193: C 01900701
194: C 01910701
195: CT004* TEST 004 **** FCVS PROGRAM 701 **** 01920701
196: C 01930701
197: C TEST 004 LOWER BOUND 01940701
198: C 01950701
199: IVTNUM = 4 01960701
200: IVCOMP = 0 01970701
201: IVCORR = -4 01980701
202: IVCOMP = I2N004(1,1) 01990701
203: 40040 IF (IVCOMP + 4) 20040, 10040, 20040 02000701
204: 10040 IVPASS = IVPASS + 1 02010701
205: WRITE (I02,80002) IVTNUM 02020701
206: GO TO 0041 02030701
207: 20040 IVFAIL = IVFAIL + 1 02040701
208: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02050701
209: 0041 CONTINUE 02060701
210: C 02070701
211: CT005* TEST 005 **** FCVS PROGRAM 701 **** 02080701
212: C 02090701
213: C TEST 005 UPPER BOUND 02100701
214: C 02110701
215: IVTNUM = 5 02120701
216: IVCOMP = 0 02130701
217: IVCORR = -5 02140701
218: IVCOMP = I2N005(1,-1) 02150701
219: 40050 IF (IVCOMP + 5) 20050, 10050, 20050 02160701
220: 10050 IVPASS = IVPASS + 1 02170701
221: WRITE (I02,80002) IVTNUM 02180701
222: GO TO 0051 02190701
223: 20050 IVFAIL = IVFAIL + 1 02200701
224: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02210701
225: 0051 CONTINUE 02220701
226: C 02230701
227: CT006* TEST 006 **** FCVS PROGRAM 701 **** 02240701
228: C 02250701
229: C TEST 006 BOTH UPPER AND LOWER BOUNDS 02260701
230: C 02270701
231: IVTNUM = 6 02280701
232: IVCOMP = 0 02290701
233: IVCORR = -6 02300701
234: IVCOMP = I2N006(-1,3) 02310701
235: 40060 IF (IVCOMP + 6) 20060, 10060, 20060 02320701
236: 10060 IVPASS = IVPASS + 1 02330701
237: WRITE (I02,80002) IVTNUM 02340701
238: GO TO 0061 02350701
239: 20060 IVFAIL = IVFAIL + 1 02360701
240: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02370701
241: 0061 CONTINUE 02380701
242: C 02390701
243: CT007* TEST 007 **** FCVS PROGRAM 701 **** 02400701
244: C 02410701
245: C TEST 007 LOWER BOUND POSITIVE 02420701
246: C 02430701
247: IVTNUM = 7 02440701
248: IVCOMP = 0 02450701
249: IVCORR = -7 02460701
250: IVCOMP = I2N007(5,2) 02470701
251: 40070 IF (IVCOMP + 7) 20070, 10070, 20070 02480701
252: 10070 IVPASS = IVPASS + 1 02490701
253: WRITE (I02,80002) IVTNUM 02500701
254: GO TO 0071 02510701
255: 20070 IVFAIL = IVFAIL + 1 02520701
256: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02530701
257: 0071 CONTINUE 02540701
258: C 02550701
259: CT008* TEST 008 **** FCVS PROGRAM 701 **** 02560701
260: C 02570701
261: C TEST 008 LOWER BOUND ZERO 02580701
262: C 02590701
263: IVTNUM = 8 02600701
264: IVCOMP = 0 02610701
265: IVCORR = -8 02620701
266: IVCOMP = I2N008(0,1) 02630701
267: 40080 IF (IVCOMP + 8) 20080, 10080, 20080 02640701
268: 10080 IVPASS = IVPASS + 1 02650701
269: WRITE (I02,80002) IVTNUM 02660701
270: GO TO 0081 02670701
271: 20080 IVFAIL = IVFAIL + 1 02680701
272: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02690701
273: 0081 CONTINUE 02700701
274: C 02710701
275: CT009* TEST 009 **** FCVS PROGRAM 701 **** 02720701
276: C 02730701
277: C TEST 009 LOWER BOUND NEGATIVE 02740701
278: C 02750701
279: IVTNUM = 9 02760701
280: IVCOMP = 0 02770701
281: IVCORR = -9 02780701
282: IVCOMP = I2N009(3,-1) 02790701
283: 40090 IF (IVCOMP + 9) 20090, 10090, 20090 02800701
284: 10090 IVPASS = IVPASS + 1 02810701
285: WRITE (I02,80002) IVTNUM 02820701
286: GO TO 0091 02830701
287: 20090 IVFAIL = IVFAIL + 1 02840701
288: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02850701
289: 0091 CONTINUE 02860701
290: C 02870701
291: CT010* TEST 010 **** FCVS PROGRAM 701 **** 02880701
292: C 02890701
293: C TEST 010 LOWER BOUND OMITTED 02900701
294: C 02910701
295: IVTNUM = 10 02920701
296: IVCOMP = 0 02930701
297: IVCORR = -10 02940701
298: IVCOMP = I2N010(1,1) 02950701
299: 40100 IF (IVCOMP + 10) 20100, 10100, 20100 02960701
300: 10100 IVPASS = IVPASS + 1 02970701
301: WRITE (I02,80002) IVTNUM 02980701
302: GO TO 0101 02990701
303: 20100 IVFAIL = IVFAIL + 1 03000701
304: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03010701
305: 0101 CONTINUE 03020701
306: C 03030701
307: CT011* TEST 011 **** FCVS PROGRAM 701 **** 03040701
308: C 03050701
309: C TEST 011 LOWER BOUND IS AN INTEGER EXPRESSION 03060701
310: C 03070701
311: IVTNUM = 11 03080701
312: IVCOMP = 0 03090701
313: IVCORR = -11 03100701
314: IVCOMP = I2N011(5,2) 03110701
315: 40110 IF (IVCOMP + 11) 20110, 10110, 20110 03120701
316: 10110 IVPASS = IVPASS + 1 03130701
317: WRITE (I02,80002) IVTNUM 03140701
318: GO TO 0111 03150701
319: 20110 IVFAIL = IVFAIL + 1 03160701
320: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03170701
321: 0111 CONTINUE 03180701
322: C 03190701
323: CT012* TEST 012 **** FCVS PROGRAM 701 **** 03200701
324: C 03210701
325: C TEST 012 UPPER BOUND POSITIVE 03220701
326: C 03230701
327: IVTNUM = 12 03240701
328: IVCOMP = 0 03250701
329: IVCORR = 7 03260701
330: IVCOMP = I2N012(1,2) 03270701
331: 40120 IF (IVCOMP - 7) 20120, 10120, 20120 03280701
332: 10120 IVPASS = IVPASS + 1 03290701
333: WRITE (I02,80002) IVTNUM 03300701
334: GO TO 0121 03310701
335: 20120 IVFAIL = IVFAIL + 1 03320701
336: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03330701
337: 0121 CONTINUE 03340701
338: C 03350701
339: CT013* TEST 013 **** FCVS PROGRAM 701 **** 03360701
340: C 03370701
341: C TEST 013 UPPER BOUND ZERO 03380701
342: C 03390701
343: IVTNUM = 13 03400701
344: IVCOMP = 0 03410701
345: IVCORR = 8 03420701
346: IVCOMP = I2N013(-2,1) 03430701
347: 40130 IF (IVCOMP - 8) 20130, 10130, 20130 03440701
348: 10130 IVPASS = IVPASS + 1 03450701
349: WRITE (I02,80002) IVTNUM 03460701
350: GO TO 0131 03470701
351: 20130 IVFAIL = IVFAIL + 1 03480701
352: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03490701
353: 0131 CONTINUE 03500701
354: C 03510701
355: CT014* TEST 014 **** FCVS PROGRAM 701 **** 03520701
356: C 03530701
357: C TEST 014 UPPER BOUND NEGATIVE 03540701
358: C 03550701
359: IVTNUM = 14 03560701
360: IVCOMP = 0 03570701
361: IVCORR = 9 03580701
362: IVCOMP = I2D014(1,-3) 03590701
363: 40140 IF (IVCOMP - 9) 20140, 10140, 20140 03600701
364: 10140 IVPASS = IVPASS + 1 03610701
365: WRITE (I02,80002) IVTNUM 03620701
366: GO TO 0141 03630701
367: 20140 IVFAIL = IVFAIL + 1 03640701
368: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03650701
369: 0141 CONTINUE 03660701
370: C 03670701
371: CT015* TEST 015 **** FCVS PROGRAM 701 **** 03680701
372: C 03690701
373: C TEST 015 UPPER BOUND IS INTEGER EXPRESSION 03700701
374: C 03710701
375: IVTNUM = 15 03720701
376: IVCOMP = 0 03730701
377: IVCORR = 10 03740701
378: IVCOMP = I2N015(5,2) 03750701
379: 40150 IF (IVCOMP - 10) 20150, 10150, 20150 03760701
380: 10150 IVPASS = IVPASS + 1 03770701
381: WRITE (I02,80002) IVTNUM 03780701
382: GO TO 0151 03790701
383: 20150 IVFAIL = IVFAIL + 1 03800701
384: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03810701
385: 0151 CONTINUE 03820701
386: C 03830701
387: CT016* TEST 016 **** FCVS PROGRAM 701 **** 03840701
388: C 03850701
389: C TEST 016 UPPER BOUNDS ARE INTEGER EXPRESSIONS 03860701
390: C 03870701
391: IVTNUM = 16 03880701
392: IVCOMP = 0 03890701
393: IVCORR = -110 03900701
394: IVCOMP = I2N016(1,1)*I2N016(2,3) 03910701
395: 40160 IF (IVCOMP + 110) 20160, 10160, 20160 03920701
396: 10160 IVPASS = IVPASS + 1 03930701
397: WRITE (I02,80002) IVTNUM 03940701
398: GO TO 0161 03950701
399: 20160 IVFAIL = IVFAIL + 1 03960701
400: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03970701
401: 0161 CONTINUE 03980701
402: C 03990701
403: CT017* TEST 017 **** FCVS PROGRAM 701 **** 04000701
404: C 04010701
405: C TEST 017 ZERO AS A DIMENSION 04020701
406: C 04030701
407: IVTNUM = 17 04040701
408: CVCOMP = ' ' 04050701
409: IVCOMP = 0 04060701
410: CVCORR = 'C001' 04070701
411: CVCOMP = C2N001(0,1) 04080701
412: IF (CVCOMP .EQ. 'C001') IVCOMP = 1 04090701
413: IF (IVCOMP - 1) 20170, 10170, 20170 04100701
414: 10170 IVPASS = IVPASS + 1 04110701
415: WRITE (I02,80002) IVTNUM 04120701
416: GO TO 0171 04130701
417: 20170 IVFAIL = IVFAIL + 1 04140701
418: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04150701
419: 0171 CONTINUE 04160701
420: C 04170701
421: CT018* TEST 018 **** FCVS PROGRAM 701 **** 04180701
422: C 04190701
423: C TEST 018 UPPER DIMENSION UNDEFINED IN THE SUBROUTINE 04200701
424: C 04210701
425: IVTNUM = 18 04220701
426: CVCOMP = ' ' 04230701
427: IVCOMP = 0 04240701
428: CVCORR = 'C002' 04250701
429: CALL SN703(1,1,2,C2D002,C2D004,CVCOMP) 04260701
430: IF (CVCOMP .EQ. 'C002') IVCOMP = 1 04270701
431: IF (IVCOMP - 1) 20180, 10180, 20180 04280701
432: 10180 IVPASS = IVPASS + 1 04290701
433: WRITE (I02,80002) IVTNUM 04300701
434: GO TO 0181 04310701
435: 20180 IVFAIL = IVFAIL + 1 04320701
436: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04330701
437: 0181 CONTINUE 04340701
438: C 04350701
439: CT019* TEST 019 **** FCVS PROGRAM 701 **** 04360701
440: C 04370701
441: C TEST 019 NEGATIVE DIMENSION 04380701
442: C 04390701
443: IVTNUM = 19 04400701
444: CVCOMP = ' ' 04410701
445: IVCOMP = 0 04420701
446: CVCORR = 'C003' 04430701
447: CVCOMP = C2N003(-2,3) 04440701
448: IF (CVCOMP .EQ. 'C003') IVCOMP = 1 04450701
449: IF (IVCOMP - 1) 20190, 10190, 20190 04460701
450: 10190 IVPASS = IVPASS + 1 04470701
451: WRITE (I02,80002) IVTNUM 04480701
452: GO TO 0191 04490701
453: 20190 IVFAIL = IVFAIL + 1 04500701
454: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04510701
455: 0191 CONTINUE 04520701
456: C 04530701
457: CT020* TEST 020 **** FCVS PROGRAM 701 **** 04540701
458: C 04550701
459: C TEST 020 VARIABLE DIMENSION 04560701
460: C 04570701
461: IVTNUM = 20 04580701
462: CVCOMP = ' ' 04590701
463: IVCOMP = 0 04600701
464: CVCORR = 'C004' 04610701
465: CALL SN703(2,1,2,C2D002,C2D004,CVCOMP) 04620701
466: IF (CVCOMP .EQ. 'C004') IVCOMP = 1 04630701
467: IF (IVCOMP - 1) 20200, 10200, 20200 04640701
468: 10200 IVPASS = IVPASS + 1 04650701
469: WRITE (I02,80002) IVTNUM 04660701
470: GO TO 0201 04670701
471: 20200 IVFAIL = IVFAIL + 1 04680701
472: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04690701
473: 0201 CONTINUE 04700701
474: C 04710701
475: CT021* TEST 021 **** FCVS PROGRAM 701 **** 04720701
476: C 04730701
477: C TEST 021 POSITIVE DIMENSION 04740701
478: C 04750701
479: IVTNUM = 21 04760701
480: CVCOMP = ' ' 04770701
481: IVCOMP = 0 04780701
482: CVCORR = 'C005' 04790701
483: CVCOMP = C1N005(1) 04800701
484: IF (CVCOMP .EQ. 'C005') IVCOMP = 1 04810701
485: IF (IVCOMP - 1) 20210, 10210, 20210 04820701
486: 10210 IVPASS = IVPASS + 1 04830701
487: WRITE (I02,80002) IVTNUM 04840701
488: GO TO 0211 04850701
489: 20210 IVFAIL = IVFAIL + 1 04860701
490: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04870701
491: 0211 CONTINUE 04880701
492: C 04890701
493: C TESTS 22-25 - MIXED DIMENSION BOUNDS WITH VARIABLE NUMBER OF 04900701
494: C ELEMENTS IN EACH DIMENSION 04910701
495: C 04920701
496: C 04930701
497: CT022* TEST 022 **** FCVS PROGRAM 701 **** 04940701
498: C 04950701
499: C 04960701
500: IVTNUM = 22 04970701
501: CVCOMP = ' ' 04980701
502: IVCOMP = 0 04990701
503: CVCORR = 'C006' 05000701
504: CALL SN704(1,1,2,5,C3D006,CVCOMP) 05010701
505: IF (CVCOMP .EQ. 'C006') IVCOMP = 1 05020701
506: IF (IVCOMP - 1) 20220, 10220, 20220 05030701
507: 10220 IVPASS = IVPASS + 1 05040701
508: WRITE (I02,80002) IVTNUM 05050701
509: GO TO 0221 05060701
510: 20220 IVFAIL = IVFAIL + 1 05070701
511: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05080701
512: 0221 CONTINUE 05090701
513: C 05100701
514: CT023* TEST 023 **** FCVS PROGRAM 701 **** 05110701
515: C 05120701
516: C 05130701
517: IVTNUM = 23 05140701
518: CVCOMP = ' ' 05150701
519: IVCOMP = 0 05160701
520: CVCORR = 'IJKL' 05170701
521: CALL SN704(2,1,2,6,C3D006,CVCOMP) 05180701
522: IF (CVCOMP .EQ. 'IJKL') IVCOMP = 1 05190701
523: IF (IVCOMP - 1) 20230, 10230, 20230 05200701
524: 10230 IVPASS = IVPASS + 1 05210701
525: WRITE (I02,80002) IVTNUM 05220701
526: GO TO 0231 05230701
527: 20230 IVFAIL = IVFAIL + 1 05240701
528: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05250701
529: 0231 CONTINUE 05260701
530: C 05270701
531: CT024* TEST 024 **** FCVS PROGRAM 701 **** 05280701
532: C 05290701
533: C 05300701
534: IVTNUM = 24 05310701
535: CVCOMP = ' ' 05320701
536: IVCOMP = 0 05330701
537: CVCORR = 'EFGH' 05340701
538: CALL SN704(3,1,1,5,C3D006,CVCOMP) 05350701
539: IF (CVCOMP .EQ. 'EFGH') IVCOMP = 1 05360701
540: IF (IVCOMP - 1) 20240, 10240, 20240 05370701
541: 10240 IVPASS = IVPASS + 1 05380701
542: WRITE (I02,80002) IVTNUM 05390701
543: GO TO 0241 05400701
544: 20240 IVFAIL = IVFAIL + 1 05410701
545: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05420701
546: 0241 CONTINUE 05430701
547: C 05440701
548: CT025* TEST 025 **** FCVS PROGRAM 701 **** 05450701
549: C 05460701
550: C 05470701
551: IVTNUM = 25 05480701
552: CVCOMP = ' ' 05490701
553: IVCOMP = 0 05500701
554: CVCORR = 'ABCD' 05510701
555: CALL SN704(4,2,2,6,C3D006,CVCOMP) 05520701
556: IF (CVCOMP .EQ. 'ABCD') IVCOMP = 1 05530701
557: IF (IVCOMP - 1) 20250, 10250, 20250 05540701
558: 10250 IVPASS = IVPASS + 1 05550701
559: WRITE (I02,80002) IVTNUM 05560701
560: GO TO 0251 05570701
561: 20250 IVFAIL = IVFAIL + 1 05580701
562: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05590701
563: 0251 CONTINUE 05600701
564: C 05610701
565: C TESTS 26-28 - LOWER BOUND IS AN EXPRESSION INVOLVING 05620701
566: C ARITHMETIC OPERATORS 05630701
567: C 05640701
568: C 05650701
569: CT026* TEST 026 **** FCVS PROGRAM 701 **** 05660701
570: C 05670701
571: C 05680701
572: IVTNUM = 26 05690701
573: IVCORR = -47 05700701
574: CALL SN705(1,2,-1,1,I2D001,I2D002,I2D003,IVCOMP) 05710701
575: 40260 IF (IVCOMP + 47) 20260, 10260, 20260 05720701
576: 10260 IVPASS = IVPASS + 1 05730701
577: WRITE (I02,80002) IVTNUM 05740701
578: GO TO 0261 05750701
579: 20260 IVFAIL = IVFAIL + 1 05760701
580: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05770701
581: 0261 CONTINUE 05780701
582: C 05790701
583: CT027* TEST 027 **** FCVS PROGRAM 701 **** 05800701
584: C 05810701
585: C 05820701
586: IVTNUM = 27 05830701
587: IVCORR = 5 05840701
588: CALL SN705(2,2,-1,1,I2D001,I2D002,I2D003,IVCOMP) 05850701
589: 40270 IF (IVCOMP - 5) 20270, 10270, 20270 05860701
590: 10270 IVPASS = IVPASS + 1 05870701
591: WRITE (I02,80002) IVTNUM 05880701
592: GO TO 0271 05890701
593: 20270 IVFAIL = IVFAIL + 1 05900701
594: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05910701
595: 0271 CONTINUE 05920701
596: C 05930701
597: CT028* TEST 028 **** FCVS PROGRAM 701 **** 05940701
598: C 05950701
599: C 05960701
600: IVTNUM = 28 05970701
601: IVCORR = 17 05980701
602: CALL SN705(3,2,-1,1,I2D001,I2D002,I2D003,IVCOMP) 05990701
603: 40280 IF (IVCOMP - 17) 20280, 10280, 20280 06000701
604: 10280 IVPASS = IVPASS + 1 06010701
605: WRITE (I02,80002) IVTNUM 06020701
606: GO TO 0281 06030701
607: 20280 IVFAIL = IVFAIL + 1 06040701
608: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06050701
609: 0281 CONTINUE 06060701
610: C 06070701
611: C TESTS 29-31 - UPPER BOUND IS AN EXPRESSION INVOLVING 06080701
612: C ARITHMETIC OPERATORS 06090701
613: C 06100701
614: C 06110701
615: CT029* TEST 029 **** FCVS PROGRAM 701 **** 06120701
616: C 06130701
617: C 06140701
618: IVTNUM = 29 06150701
619: IVCORR = -47 06160701
620: CALL SN706(1,4,0,3,I2D001,I2D002,I2D003,IVCOMP) 06170701
621: 40290 IF (IVCOMP + 47) 20290, 10290, 20290 06180701
622: 10290 IVPASS = IVPASS + 1 06190701
623: WRITE (I02,80002) IVTNUM 06200701
624: GO TO 0291 06210701
625: 20290 IVFAIL = IVFAIL + 1 06220701
626: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06230701
627: 0291 CONTINUE 06240701
628: C 06250701
629: CT030* TEST 030 **** FCVS PROGRAM 701 **** 06260701
630: C 06270701
631: C 06280701
632: IVTNUM = 30 06290701
633: IVCORR = 5 06300701
634: CALL SN706(2,4,0,3,I2D001,I2D002,I2D003,IVCOMP) 06310701
635: 40300 IF (IVCOMP - 5) 20300, 10300, 20300 06320701
636: 10300 IVPASS = IVPASS + 1 06330701
637: WRITE (I02,80002) IVTNUM 06340701
638: GO TO 0301 06350701
639: 20300 IVFAIL = IVFAIL + 1 06360701
640: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06370701
641: 0301 CONTINUE 06380701
642: C 06390701
643: CT031* TEST 031 **** FCVS PROGRAM 701 **** 06400701
644: C 06410701
645: C 06420701
646: IVTNUM = 31 06430701
647: IVCORR = 17 06440701
648: CALL SN706(3,4,0,3,I2D001,I2D002,I2D003,IVCOMP) 06450701
649: 40310 IF (IVCOMP - 17) 20310, 10310, 20310 06460701
650: 10310 IVPASS = IVPASS + 1 06470701
651: WRITE (I02,80002) IVTNUM 06480701
652: GO TO 0311 06490701
653: 20310 IVFAIL = IVFAIL + 1 06500701
654: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06510701
655: 0311 CONTINUE 06520701
656: C 06530701
657: CT032* TEST 032 **** FCVS PROGRAM 701 **** 06540701
658: C 06550701
659: C TEST 032 "/" IN LOWER BOUND 06560701
660: C 06570701
661: IVTNUM = 32 06580701
662: IVCORR = -47 06590701
663: CALL SN707(1,3,2,I2D001,I2D002,IVCOMP) 06600701
664: 40320 IF (IVCOMP + 47) 20320, 10320, 20320 06610701
665: 10320 IVPASS = IVPASS + 1 06620701
666: WRITE (I02,80002) IVTNUM 06630701
667: GO TO 0321 06640701
668: 20320 IVFAIL = IVFAIL + 1 06650701
669: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06660701
670: 0321 CONTINUE 06670701
671: C 06680701
672: CT033* TEST 033 **** FCVS PROGRAM 701 **** 06690701
673: C 06700701
674: C TEST 033 "**" IN UPPER BOUND 06710701
675: C 06720701
676: IVTNUM = 33 06730701
677: IVCORR = 5 06740701
678: CALL SN707(2,3,2,I2D001,I2D002,IVCOMP) 06750701
679: 40330 IF (IVCOMP - 5) 20330, 10330, 20330 06760701
680: 10330 IVPASS = IVPASS + 1 06770701
681: WRITE (I02,80002) IVTNUM 06780701
682: GO TO 0331 06790701
683: 20330 IVFAIL = IVFAIL + 1 06800701
684: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06810701
685: 0331 CONTINUE 06820701
686: C 06830701
687: C TESTS 34-35 - UPPER AND LOWER BOUNDS WITH ARITHMETIC OPERATORS 06840701
688: C IN EXPRESSION 06850701
689: C 06860701
690: C 06870701
691: CT034* TEST 034 **** FCVS PROGRAM 701 **** 06880701
692: C 06890701
693: C 06900701
694: IVTNUM = 34 06910701
695: IVCORR = -47 06920701
696: CALL SN708(3,-2,2,I2D001,IVCOMP) 06930701
697: 40340 IF (IVCOMP + 47) 20340, 10340, 20340 06940701
698: 10340 IVPASS = IVPASS + 1 06950701
699: WRITE (I02,80002) IVTNUM 06960701
700: GO TO 0341 06970701
701: 20340 IVFAIL = IVFAIL + 1 06980701
702: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06990701
703: 0341 CONTINUE 07000701
704: C 07010701
705: CT035* TEST 035 **** FCVS PROGRAM 701 **** 07020701
706: C 07030701
707: C 07040701
708: IVTNUM = 35 07050701
709: IVCORR = 9 07060701
710: CALL SN709(-1,-2,1,I2D014,IVCOMP) 07070701
711: 40350 IF (IVCOMP - 9) 20350, 10350, 20350 07080701
712: 10350 IVPASS = IVPASS + 1 07090701
713: WRITE (I02,80002) IVTNUM 07100701
714: GO TO 0351 07110701
715: 20350 IVFAIL = IVFAIL + 1 07120701
716: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07130701
717: 0351 CONTINUE 07140701
718: C 07150701
719: CBB** ********************** BBCSUM0 **********************************07160701
720: C**** WRITE OUT TEST SUMMARY 07170701
721: C**** 07180701
722: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 07190701
723: WRITE (I02, 90004) 07200701
724: WRITE (I02, 90014) 07210701
725: WRITE (I02, 90004) 07220701
726: WRITE (I02, 90020) IVPASS 07230701
727: WRITE (I02, 90022) IVFAIL 07240701
728: WRITE (I02, 90024) IVDELE 07250701
729: WRITE (I02, 90026) IVINSP 07260701
730: WRITE (I02, 90028) IVTOTN, IVTOTL 07270701
731: CBE** ********************** BBCSUM0 **********************************07280701
732: CBB** ********************** BBCFOOT0 **********************************07290701
733: C**** WRITE OUT REPORT FOOTINGS 07300701
734: C**** 07310701
735: WRITE (I02,90016) ZPROG, ZPROG 07320701
736: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 07330701
737: WRITE (I02,90019) 07340701
738: CBE** ********************** BBCFOOT0 **********************************07350701
739: 90001 FORMAT (1H ,56X,5HFM701) 07360701
740: 90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM701) 07370701
741: CBB** ********************** BBCFMT0A **********************************07380701
742: C**** FORMATS FOR TEST DETAIL LINES 07390701
743: C**** 07400701
744: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 07410701
745: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 07420701
746: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 07430701
747: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 07440701
748: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 07450701
749: 1I6,/,1H ,15X,10HCORRECT= ,I6) 07460701
750: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 07470701
751: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 07480701
752: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 07490701
753: 1A21,/,1H ,16X,10HCORRECT= ,A21) 07500701
754: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 07510701
755: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 07520701
756: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 07530701
757: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 07540701
758: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 07550701
759: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 07560701
760: 80050 FORMAT (1H ,48X,A31) 07570701
761: CBE** ********************** BBCFMT0A **********************************07580701
762: CBB** ********************** BBCFMAT1 **********************************07590701
763: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 07600701
764: C**** 07610701
765: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 07620701
766: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 07630701
767: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 07640701
768: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 07650701
769: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 07660701
770: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 07670701
771: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 07680701
772: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 07690701
773: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 07700701
774: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 07710701
775: 21H(,F12.5,2H, ,F12.5,1H)) 07720701
776: CBE** ********************** BBCFMAT1 **********************************07730701
777: CBB** ********************** BBCFMT0B **********************************07740701
778: C**** FORMAT STATEMENTS FOR PAGE HEADERS 07750701
779: C**** 07760701
780: 90002 FORMAT (1H1) 07770701
781: 90004 FORMAT (1H ) 07780701
782: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 07790701
783: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 07800701
784: 90008 FORMAT (1H ,21X,A13,A17) 07810701
785: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 07820701
786: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 07830701
787: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 07840701
788: 1 7X,7HREMARKS,24X) 07850701
789: 90014 FORMAT (1H ,46H----------------------------------------------, 07860701
790: 1 33H---------------------------------) 07870701
791: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 07880701
792: C**** 07890701
793: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 07900701
794: C**** 07910701
795: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 07920701
796: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 07930701
797: 1 A13) 07940701
798: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 07950701
799: C**** 07960701
800: C**** FORMAT STATEMENTS FOR RUN SUMMARY 07970701
801: C**** 07980701
802: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 07990701
803: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 08000701
804: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 08010701
805: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 08020701
806: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 08030701
807: CBE** ********************** BBCFMT0B **********************************08040701
808: END 08050701
809: C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010702
810: C DATE***82/08/02*18.33.46
811: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
812: C AUDIT FCVS78 V2.0
813: C 00020702
814: C THIS SUBROUTINE TESTS DIMENSION BOUND EXPRESSIONS 00030702
815: C CONTAINING VARIABLES OF TYPE INTEGER. 00040702
816: C 00050702
817: SUBROUTINE SN702(IVD001,IVD002,IVD003,IVD004,I2D001,I2D002,I2D003,00060702
818: 1 IVD005) 00070702
819: C 00080702
820: DIMENSION I2D001(IVD002:3,1:5), I2D002(2,1:2*IVD003), 00090702
821: 1 I2D003(IVD004/3 - 1 : IVD002 + 4, 1:2) 00100702
822: C 00110702
823: IF (IVD001 - 2) 70010, 70020, 70030 00120702
824: 70010 IVD005 = I2D001(1,5) 00130702
825: RETURN 00140702
826: 70020 IVD005 = I2D002(1,4) 00150702
827: RETURN 00160702
828: 70030 IVD005 = I2D003(1,1) - I2D003(5,2) 00170702
829: RETURN 00180702
830: END 00190702
831: C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010703
832: C DATE***82/08/02*18.33.46
833: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
834: C AUDIT FCVS78 V2.0
835: C 00020703
836: C THIS SUBROUTINE TESTS ASSUMED-SIZE ARRAY DECLARATORS 00030703
837: C AND ADJUSTABLE ARRAY DECLARATORS. 00040703
838: C 00050703
839: SUBROUTINE SN703(IVD001,IVD002,IVD003,C2D001,C2D002,CVD001) 00060703
840: C 00070703
841: CHARACTER*4 CVD001, C2D001(2,1:*), C2D002(IVD002:IVD003,5:7) 00080703
842: C 00090703
843: IF (IVD001 - 1) 70010, 70010, 70020 00100703
844: 70010 CVD001 = C2D001(2,3) 00110703
845: RETURN 00120703
846: 70020 CVD001 = C2D002(1,5) 00130703
847: RETURN 00140703
848: END 00150703
849: C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010704
850: C DATE***82/08/02*18.33.46
851: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
852: C AUDIT FCVS78 V2.0
853: C 00020704
854: C THIS SUBROUTINE TESTS ADJUSTABLE ARRAY DECLARATORS. 00030704
855: C 00040704
856: SUBROUTINE SN704(IVD001,IVD002,IVD003,IVD004,C3D001,CVD001) 00050704
857: C 00060704
858: CHARACTER*4 CVD001, C3D001(IVD002:IVD003,2,IVD004:7) 00070704
859: C 00080704
860: IF (IVD001 - 2) 70010, 70020, 70030 00090704
861: 70010 CVD001 = C3D001(1,1,5) 00100704
862: RETURN 00110704
863: 70020 C3D001(1,2,6) = 'IJKL' 00120704
864: CVD001 = C3D001(1,2,6) 00130704
865: RETURN 00140704
866: 70030 IF (IVD001 - 3) 70040, 70040, 70050 00150704
867: 70040 C3D001(1,1,5) = 'EFGH' 00160704
868: CVD001 = C3D001(1,1,5) 00170704
869: RETURN 00180704
870: 70050 C3D001(2,2,6) = 'ABCD' 00190704
871: CVD001 = C3D001(2,2,6) 00200704
872: RETURN 00210704
873: END 00220704
874: C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010705
875: C DATE***82/08/02*18.33.46
876: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
877: C AUDIT FCVS78 V2.0
878: C 00020705
879: C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE THE LOWER BOUNDS 00030705
880: C CONTAIN ARITHMETIC EXPRESSIONS OF TYPE 00040705
881: C INTEGER. 00050705
882: C 00060705
883: SUBROUTINE SN705(IVD001,IVD002,IVD003,IVD004,I2D001,I2D002,I2D003,00070705
884: 1 IVD005) 00080705
885: C 00090705
886: DIMENSION I2D001(IVD002-1:3,1:5),I2D002(IVD003+2:2,1:4), 00100705
887: 1 I2D003(2*IVD004-1:5,2) 00110705
888: C 00120705
889: IF (IVD001 - 2) 70010, 70020, 70030 00130705
890: 70010 IVD005 = I2D001(1,5) 00140705
891: RETURN 00150705
892: 70020 IVD005 = I2D002(1,4) 00160705
893: RETURN 00170705
894: 70030 IVD005 = I2D003(1,1) - I2D003(5,2) 00180705
895: RETURN 00190705
896: END 00200705
897: C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010706
898: C DATE***82/08/02*18.33.46
899: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
900: C AUDIT FCVS78 V2.0
901: C 00020706
902: C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE THE UPPER BOUNDS 00030706
903: C CONTAIN ARITHMETIC EXPRESSIONS OF TYPE 00040706
904: C INTEGER. 00050706
905: C 00060706
906: SUBROUTINE SN706(IVD001,IVD002,IVD003,IVD004,I2D001,I2D002,I2D003,00070706
907: 1 IVD005) 00080706
908: C 00090706
909: DIMENSION I2D001(1:IVD002-1,1:5),I2D002(1:IVD003+2,1:4), 00100706
910: 1 I2D003(1:2*IVD004-1,2) 00110706
911: C 00120706
912: IF (IVD001 - 2) 70010, 70020, 70030 00130706
913: 70010 IVD005 = I2D001(1,5) 00140706
914: RETURN 00150706
915: 70020 IVD005 = I2D002(1,4) 00160706
916: RETURN 00170706
917: 70030 IVD005 = I2D003(1,1) - I2D003(5,2) 00180706
918: RETURN 00190706
919: END 00200706
920: C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010707
921: C DATE***82/08/02*18.33.46
922: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
923: C AUDIT FCVS78 V2.0
924: C 00020707
925: C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE BOUND EXPRESSIONS 00030707
926: C MAY CONTAIN DIVISION OPERATORS OR 00040707
927: C EXPONENTIATION OPERATORS. 00050707
928: C 00060707
929: SUBROUTINE SN707(IVD001,IVD002,IVD003,I2D001,I2D002,IVD004) 00070707
930: C 00080707
931: DIMENSION I2D001(IVD002/3:3,1:5),I2D002(1:2,1:IVD003**2) 00090707
932: C 00100707
933: IF (IVD001 - 1) 70010, 70010, 70020 00110707
934: 70010 IVD004 = I2D001(1,5) 00120707
935: RETURN 00130707
936: 70020 IVD004 = I2D002(1,4) 00140707
937: RETURN 00150707
938: END 00160707
939: C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010708
940: C DATE***82/08/02*18.33.46
941: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
942: C AUDIT FCVS78 V2.0
943: C 00020708
944: C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE BOTH THE LOWER 00030708
945: C AND UPPER BOUNDS CONTAIN ARITHMETIC 00040708
946: C EXPRESSIONS OF TYPE INTEGER. 00050708
947: C 00060708
948: SUBROUTINE SN708(IVD001,IVD002,IVD003,I2D001,IVD004) 00070708
949: C 00080708
950: DIMENSION I2D001(IVD001/3:IVD001,IVD002+3 : 4*(2*IVD003-1)/3 + 1) 00090708
951: C 00100708
952: IVD004 = I2D001(1,5) 00110708
953: RETURN 00120708
954: END 00130708
955: C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010709
956: C DATE***82/08/02*18.33.46
957: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
958: C AUDIT FCVS78 V2.0
959: C 00020709
960: C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE THE BOUND 00030709
961: C EXPRESSIONS CONTAIN SYMBOLIC NAMES 00040709
962: C OF CONSTANTS OR VARIABLES OF TYPE 00050709
963: C INTEGER. 00060709
964: C 00070709
965: SUBROUTINE SN709(IVD001,IVD002,IVD003,I2D001,IVD005) 00080709
966: C 00090709
967: PARAMETER (IPN001=-3) 00100709
968: DIMENSION I2D001(IPN001+4:(2*IVD003 + 1),IPN001:(1-IVD001)/IVD002)00110709
969: C 00120709
970: IVD005 = I2D001(1,-3) 00130709
971: RETURN 00140709
972: END 00150709
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.