|
|
1.1 root 1: PROGRAM FM509 00010509
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 00020509
6: C THIS ROUTINE TESTS SUBROUTINE SUBPROGRAMS AND ANS REF. 00030509
7: C FUNCTION SUBPROGRAMS WITH MULTIPLE ENTRIES. 15.6.1 00040509
8: C THIS ROUTINE ALSO TESTS THE USE OF SYMBOLIC 15.7, 15.7.1 00050509
9: C NAMES OF CONSTANTS, SUBSTRINGS NAMES, AND 15.9.2 00060509
10: C ARRAY ELEMENT SUBSTRINGS AS ARGUMENTS. 15.9.3.2 00070509
11: C 15.9.3.3 00080509
12: C THIS ROUTINE USES THE SUBROUTINE SUBPROGRAMS SN510, 00090509
13: C SN511, AND SN512, AND THE FUNCTION SUBPROGRAM RF513. 00100509
14: C 00110509
15: CBB** ********************** BBCCOMNT **********************************00120509
16: C**** 00130509
17: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140509
18: C**** VERSION 2.0 00150509
19: C**** 00160509
20: C**** 00170509
21: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180509
22: C**** GENERAL SERVICES ADMINISTRATION 00190509
23: C**** FEDERAL SOFTWARE TESTING CENTER 00200509
24: C**** 5203 LEESBURG PIKE, SUITE 1100 00210509
25: C**** FALLS CHURCH, VA. 22041 00220509
26: C**** 00230509
27: C**** (703) 756-6153 00240509
28: C**** 00250509
29: CBE** ********************** BBCCOMNT **********************************00260509
30: IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00270509
31: IMPLICIT CHARACTER*27 (C) 00280509
32: CBB** ********************** BBCINITA **********************************00290509
33: C**** SPECIFICATION STATEMENTS 00300509
34: C**** 00310509
35: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320509
36: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330509
37: CBE** ********************** BBCINITA **********************************00340509
38: C 00350509
39: INTEGER I2N001(2,2) 00360509
40: CHARACTER CVCOMP*12,CVCORR*12,CVN001*30 00370509
41: CHARACTER C1N001(6)*10 00380509
42: PARAMETER (IPN001=31) 00390509
43: COMMON IVC001, IVC002, IVC003 00400509
44: EXTERNAL RF513 00410509
45: DATA I2N001 /1, 3, 5, 7/ 00420509
46: DATA CVN001 /'REDORANGEYELLOWGREENBLUEVIOLET'/ 00430509
47: DATA C1N001 /'FIRST-AID:','SECONDRATE','THIRD-TERM', 00440509
48: 1 'FOURTH-DAY','FIFTHROUND','SIXTHMONTH'/ 00450509
49: C 00460509
50: C 00470509
51: CBB** ********************** BBCINITB **********************************00480509
52: C**** INITIALIZE SECTION 00490509
53: DATA ZVERS, ZVERSD, ZDATE 00500509
54: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00510509
55: DATA ZCOMPL, ZNAME, ZTAPE 00520509
56: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00530509
57: DATA ZPROJ, ZTAPED, ZPROG 00540509
58: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00550509
59: DATA REMRKS /' '/ 00560509
60: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00570509
61: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00580509
62: C**** 00590509
63: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00600509
64: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00610509
65: CZ03 ZPROG = 'PROGRAM NAME' 00620509
66: ZDATE = '07-Nov-85 ' *RP
67: ZCOMPL = 'CCI 5.2 ' *RP
68: ZPROJ = 'TC-85- -410' *RP
69: ZNAME = ' ' *RP
70: ZTAPE = ' ' *RP
71: ZTAPED = '850703 ' *RP
72: C 00690509
73: IVPASS = 0 00700509
74: IVFAIL = 0 00710509
75: IVDELE = 0 00720509
76: IVINSP = 0 00730509
77: IVTOTL = 0 00740509
78: IVTOTN = 0 00750509
79: ICZERO = 0 00760509
80: C 00770509
81: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00780509
82: I01 = 05 00790509
83: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00800509
84: I02 = 06 00810509
85: C 00820509
86: I01 = 5 00830509
87: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00840509
88: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00850509
89: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00860509
90: C 00870509
91: I02 = 6 00880509
92: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00890509
93: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00900509
94: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00910509
95: C 00920509
96: CBE** ********************** BBCINITB **********************************00930509
97: ZPROG = 'FM509' 00940509
98: IVTOTL = 16 00950509
99: CBB** ********************** BBCHED0A **********************************00960509
100: C**** 00970509
101: C**** WRITE REPORT TITLE 00980509
102: C**** 00990509
103: WRITE (I02, 90002) 01000509
104: WRITE (I02, 90006) 01010509
105: WRITE (I02, 90007) 01020509
106: WRITE (I02, 90008) ZVERS, ZVERSD 01030509
107: WRITE (I02, 90009) ZPROG, ZPROG 01040509
108: WRITE (I02, 90010) ZDATE, ZCOMPL 01050509
109: CBE** ********************** BBCHED0A **********************************01060509
110: CBB** ********************** BBCHED0B **********************************01070509
111: C**** WRITE DETAIL REPORT HEADERS 01080509
112: C**** 01090509
113: WRITE (I02,90004) 01100509
114: WRITE (I02,90004) 01110509
115: WRITE (I02,90013) 01120509
116: WRITE (I02,90014) 01130509
117: WRITE (I02,90015) IVTOTL 01140509
118: CBE** ********************** BBCHED0B **********************************01150509
119: C 01160509
120: CT001* TEST 001 **** FCVS PROGRAM 509 **** 01170509
121: C SUBROUTINE WITH MULTIPLE ENTRIES 01180509
122: C 01190509
123: IVTNUM = 1 01200509
124: IVCOMP = 0 01210509
125: IVCORR = 25 01220509
126: IVD020=3 01220*TI
127: CALL SN510(IVD020,IVN001) 01230*TI
128: CALL EN851(IVN001,IVCOMP) 01240509
129: 40010 IF (IVCOMP - 25) 20010, 10010, 20010 01250509
130: 10010 IVPASS = IVPASS + 1 01260509
131: WRITE (I02,80002) IVTNUM 01270509
132: GO TO 0011 01280509
133: 20010 IVFAIL = IVFAIL + 1 01290509
134: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01300509
135: 0011 CONTINUE 01310509
136: C 01320509
137: CT002* TEST 002 **** FCVS PROGRAM 509 **** 01330509
138: C ENTRY WITH ONE ARGUMENT 01340509
139: C 01350509
140: IVTNUM = 2 01360509
141: IVCOMP = 0 01370509
142: IVCORR = 137 01380509
143: IVN001 = 37 01390509
144: CALL EN852(IVN001) 01400509
145: IVCOMP = IVN001 01410509
146: 40020 IF (IVCOMP - 137) 20020, 10020, 20020 01420509
147: 10020 IVPASS = IVPASS + 1 01430509
148: WRITE (I02,80002) IVTNUM 01440509
149: GO TO 0021 01450509
150: 20020 IVFAIL = IVFAIL + 1 01460509
151: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01470509
152: 0021 CONTINUE 01480509
153: C 01490509
154: CT003* TEST 003 **** FCVS PROGRAM 509 **** 01500509
155: C ENTRY WITH TWO ARGUMENT 01510509
156: C 01520509
157: IVTNUM = 3 01530509
158: IVCOMP = 0 01540509
159: IVCORR = -51 01550509
160: CALL EN853(-9,IVCOMP) 01560509
161: 40030 IF (IVCOMP + 51) 20030, 10030, 20030 01570509
162: 10030 IVPASS = IVPASS + 1 01580509
163: WRITE (I02,80002) IVTNUM 01590509
164: GO TO 0031 01600509
165: 20030 IVFAIL = IVFAIL + 1 01610509
166: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01620509
167: 0031 CONTINUE 01630509
168: C 01640509
169: CT004* TEST 004 **** FCVS PROGRAM 509 **** 01650509
170: C ENTRY WITH THREE ARGUMENTS 01660509
171: C 01670509
172: IVTNUM = 4 01680509
173: IVCOMP = 0 01690509
174: IVCORR = -71 01700509
175: CALL EN854(275,147,IVCOMP) 01710509
176: 40040 IF (IVCOMP + 71) 20040, 10040, 20040 01720509
177: 10040 IVPASS = IVPASS + 1 01730509
178: WRITE (I02,80002) IVTNUM 01740509
179: GO TO 0041 01750509
180: 20040 IVFAIL = IVFAIL + 1 01760509
181: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01770509
182: 0041 CONTINUE 01780509
183: C 01790509
184: CT005* TEST 005 **** FCVS PROGRAM 509 **** 01800509
185: C ENTRY WITH FOUR ARGUMENTS 01810509
186: C 01820509
187: IVTNUM = 5 01830509
188: IVCOMP = 0 01840509
189: IVCORR = 567 01850509
190: CALL EN855(12,-15,63,IVCOMP) 01860509
191: 40050 IF (IVCOMP - 567) 20050, 10050, 20050 01870509
192: 10050 IVPASS = IVPASS + 1 01880509
193: WRITE (I02,80002) IVTNUM 01890509
194: GO TO 0051 01900509
195: 20050 IVFAIL = IVFAIL + 1 01910509
196: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01920509
197: 0051 CONTINUE 01930509
198: C 01940509
199: CT006* TEST 006 **** FCVS PROGRAM 509 **** 01950509
200: C ENTRY WITH ARRAY AS DUMMY ARGUMENT 01960509
201: C 01970509
202: IVTNUM = 6 01980509
203: IVCOMP = 0 01990509
204: IVCORR = 16 02000509
205: IVN001 = 2 02010509
206: CALL EN856(IVN001,I2N001,IVCOMP) 02020509
207: 40060 IF (IVCOMP - 16) 20060, 10060, 20060 02030509
208: 10060 IVPASS = IVPASS + 1 02040509
209: WRITE (I02,80002) IVTNUM 02050509
210: GO TO 0061 02060509
211: 20060 IVFAIL = IVFAIL + 1 02070509
212: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02080509
213: 0061 CONTINUE 02090509
214: C 02100509
215: CT007* TEST 007 **** FCVS PROGRAM 509 **** 02110509
216: C ENTRY WITH PROCEDURE AS DUMMY ARGUMENT 02120509
217: C 02130509
218: IVTNUM = 7 02140509
219: RVCOMP = 0.0 02150509
220: RVCORR = 2.25 02160509
221: CALL EN857(1.5,RVCOMP,RF513) 02170509
222: IF (RVCOMP - 0.22498E+01) 20070, 10070, 40070 02180509
223: 40070 IF (RVCOMP - 0.22502E+01) 10070, 10070, 20070 02190509
224: 10070 IVPASS = IVPASS + 1 02200509
225: WRITE (I02,80002) IVTNUM 02210509
226: GO TO 0071 02220509
227: 20070 IVFAIL = IVFAIL + 1 02230509
228: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02240509
229: 0071 CONTINUE 02250509
230: C 02260509
231: CT008* TEST 008 **** FCVS PROGRAM 509 **** 02270509
232: C ENTRY WITH ASTERISK AS DUMMY ARGUMENT 02280509
233: C 02290509
234: IVTNUM = 8 02300509
235: IVCOMP = 0 02310509
236: IVCORR = 19 02320509
237: IVN001 = 2 02330509
238: CALL EN858(IVN001,*0082,*0083) 02340509
239: 0082 IVCOMP = 5 02350509
240: GO TO 0084 02360509
241: 0083 IVCOMP = 19 02370509
242: 0084 CONTINUE 02380509
243: 40080 IF (IVCOMP - 19) 20080, 10080, 20080 02390509
244: 10080 IVPASS = IVPASS + 1 02400509
245: WRITE (I02,80002) IVTNUM 02410509
246: GO TO 0081 02420509
247: 20080 IVFAIL = IVFAIL + 1 02430509
248: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02440509
249: 0081 CONTINUE 02450509
250: C 02460509
251: C TESTS 9 AND 10 TEST ENTRY WITHOUT ARGUMENTS 02470509
252: C 02480509
253: CT009* TEST 009 **** FCVS PROGRAM 509 **** 02490509
254: C 02500509
255: IVTNUM = 9 02510509
256: IVCOMP = 0 02520509
257: IVCORR = 88 02530509
258: IVC002 = 65 02540509
259: IVC003 = 23 02550509
260: CALL EN859( ) 02560509
261: IVCOMP = IVC001 02570509
262: 40090 IF (IVCOMP - 88) 20090, 10090, 20090 02580509
263: 10090 IVPASS = IVPASS + 1 02590509
264: WRITE (I02,80002) IVTNUM 02600509
265: GO TO 0091 02610509
266: 20090 IVFAIL = IVFAIL + 1 02620509
267: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02630509
268: 0091 CONTINUE 02640509
269: C 02650509
270: CT010* TEST 010 **** FCVS PROGRAM 509 **** 02660509
271: C 02670509
272: IVTNUM = 10 02680509
273: IVCOMP = 0 02690509
274: IVCORR = -13 02700509
275: IVC001 = 4 02710509
276: IVC002 = -17 02720509
277: CALL EN860 02730509
278: IVCOMP = IVC003 02740509
279: 40100 IF (IVCOMP + 13) 20100, 10100, 20100 02750509
280: 10100 IVPASS = IVPASS + 1 02760509
281: WRITE (I02,80002) IVTNUM 02770509
282: GO TO 0101 02780509
283: 20100 IVFAIL = IVFAIL + 1 02790509
284: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02800509
285: 0101 CONTINUE 02810509
286: C 02820509
287: CT011* TEST 011 **** FCVS PROGRAM 509 **** 02830509
288: C FUNCTION SUBPROGRAM WITH MULTIPLE ENTRIES 02840509
289: C 02850509
290: IVTNUM = 11 02860509
291: RVCOMP = 0.0 02870509
292: RVCORR = 3.675E-3 02880509
293: RVN001 = RF513(3.5E-2) 02890509
294: RVCOMP = EF852(RVN001) 02900509
295: IF (RVCOMP - 0.36748E-02) 20110, 10110, 40110 02910509
296: 40110 IF (RVCOMP - 0.36752E-02) 10110, 10110, 20110 02920509
297: 10110 IVPASS = IVPASS + 1 02930509
298: WRITE (I02,80002) IVTNUM 02940509
299: GO TO 0111 02950509
300: 20110 IVFAIL = IVFAIL + 1 02960509
301: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02970509
302: 0111 CONTINUE 02980509
303: C 02990509
304: CT012* TEST 012 **** FCVS PROGRAM 509 **** 03000509
305: C SYMBOLIC NAME OF A CONSTANT AS AN ACTUAL ARGUMENT 03010509
306: C 03020509
307: IVTNUM = 12 03030509
308: IVCOMP = 0 03040509
309: IVCORR = 34 03050509
310: CALL SN510(IPN001,IVCOMP) 03060509
311: 40120 IF (IVCOMP - 34) 20120, 10120, 20120 03070509
312: 10120 IVPASS = IVPASS + 1 03080509
313: WRITE (I02,80002) IVTNUM 03090509
314: GO TO 0121 03100509
315: 20120 IVFAIL = IVFAIL + 1 03110509
316: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03120509
317: 0121 CONTINUE 03130509
318: C 03140509
319: C TESTS 13 AND 14 TEST THE USE OF A SUBSTRING AS AN ACTUAL ARGUMENT 03150509
320: C WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIABLE 03160509
321: C 03170509
322: C 03180509
323: CT013* TEST 013 **** FCVS PROGRAM 509 **** 03190509
324: C 03200509
325: IVTNUM = 13 03210509
326: CVCOMP = ' ' 03220509
327: CVCORR = 'COLOR=YELLOW ' 03230509
328: CALL SN511(CVN001(10:15),CVCOMP) 03240509
329: IVCOMP = 0 03250509
330: IF (CVCOMP.EQ.'COLOR=YELLOW ') IVCOMP = 1 03260509
331: 40130 IF (IVCOMP - 1) 20130, 10130, 20130 03270509
332: 10130 IVPASS = IVPASS + 1 03280509
333: WRITE (I02,80002) IVTNUM 03290509
334: GO TO 0131 03300509
335: 20130 IVFAIL = IVFAIL + 1 03310509
336: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03320509
337: 0131 CONTINUE 03330509
338: C 03340509
339: CT014* TEST 014 **** FCVS PROGRAM 509 **** 03350509
340: C 03360509
341: IVTNUM = 14 03370509
342: CVCOMP = ' ' 03380509
343: CVCORR = 'COLOR=VIOLET ' 03390509
344: CALL SN511(CVN001(25:30),CVCOMP) 03400509
345: IVCOMP = 0 03410509
346: IF (CVCOMP.EQ.'COLOR=VIOLET ') IVCOMP = 1 03420509
347: 40140 IF (IVCOMP - 1) 20140, 10140, 20140 03430509
348: 10140 IVPASS = IVPASS + 1 03440509
349: WRITE (I02,80002) IVTNUM 03450509
350: GO TO 0141 03460509
351: 20140 IVFAIL = IVFAIL + 1 03470509
352: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03480509
353: 0141 CONTINUE 03490509
354: C 03500509
355: C TESTS 15 AND 16 TEST THE USE OF AN ARRAY ELEMENT SUBSTRING AS AN 03510509
356: C ACTUAL ARGUMENT WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT 03520509
357: C IS AN ARRAY 03530509
358: C 03540509
359: C 03550509
360: CT015* TEST 015 **** FCVS PROGRAM 509 **** 03560509
361: C 03570509
362: IVTNUM = 15 03580509
363: CVCOMP = ' ' 03590509
364: CVCORR = 'RST-AID: ' 03600509
365: CALL SN512(C1N001(1)(3:10),CVCOMP) 03610509
366: IVCOMP = 0 03620509
367: IF (CVCOMP.EQ.'RST-AID: ') IVCOMP = 1 03630509
368: 40150 IF (IVCOMP - 1) 20150, 10150, 20150 03640509
369: 10150 IVPASS = IVPASS + 1 03650509
370: WRITE (I02,80002) IVTNUM 03660509
371: GO TO 0151 03670509
372: 20150 IVFAIL = IVFAIL + 1 03680509
373: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03690509
374: 0151 CONTINUE 03700509
375: C 03710509
376: CT016* TEST 016 **** FCVS PROGRAM 509 **** 03720509
377: C 03730509
378: IVTNUM = 16 03740509
379: CVCOMP = ' ' 03750509
380: CVCORR = 'IFTHROUN ' 03760509
381: CALL SN512(C1N001(5)(2:9),CVCOMP) 03770509
382: IVCOMP = 0 03780509
383: IF (CVCOMP.EQ.'IFTHROUN ') IVCOMP = 1 03790509
384: 40160 IF (IVCOMP - 1) 20160, 10160, 20160 03800509
385: 10160 IVPASS = IVPASS + 1 03810509
386: WRITE (I02,80002) IVTNUM 03820509
387: GO TO 0161 03830509
388: 20160 IVFAIL = IVFAIL + 1 03840509
389: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03850509
390: 0161 CONTINUE 03860509
391: C 03870509
392: CBB** ********************** BBCSUM0 **********************************03880509
393: C**** WRITE OUT TEST SUMMARY 03890509
394: C**** 03900509
395: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03910509
396: WRITE (I02, 90004) 03920509
397: WRITE (I02, 90014) 03930509
398: WRITE (I02, 90004) 03940509
399: WRITE (I02, 90020) IVPASS 03950509
400: WRITE (I02, 90022) IVFAIL 03960509
401: WRITE (I02, 90024) IVDELE 03970509
402: WRITE (I02, 90026) IVINSP 03980509
403: WRITE (I02, 90028) IVTOTN, IVTOTL 03990509
404: CBE** ********************** BBCSUM0 **********************************04000509
405: CBB** ********************** BBCFOOT0 **********************************04010509
406: C**** WRITE OUT REPORT FOOTINGS 04020509
407: C**** 04030509
408: WRITE (I02,90016) ZPROG, ZPROG 04040509
409: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04050509
410: WRITE (I02,90019) 04060509
411: CBE** ********************** BBCFOOT0 **********************************04070509
412: 90001 FORMAT (1H ,56X,5HFM509) 04080509
413: 90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM509) 04090509
414: CBB** ********************** BBCFMT0A **********************************04100509
415: C**** FORMATS FOR TEST DETAIL LINES 04110509
416: C**** 04120509
417: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 04130509
418: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 04140509
419: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 04150509
420: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 04160509
421: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 04170509
422: 1I6,/,1H ,15X,10HCORRECT= ,I6) 04180509
423: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04190509
424: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 04200509
425: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04210509
426: 1A21,/,1H ,16X,10HCORRECT= ,A21) 04220509
427: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 04230509
428: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 04240509
429: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 04250509
430: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 04260509
431: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 04270509
432: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 04280509
433: 80050 FORMAT (1H ,48X,A31) 04290509
434: CBE** ********************** BBCFMT0A **********************************04300509
435: CBB** ********************** BBCFMAT1 **********************************04310509
436: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04320509
437: C**** 04330509
438: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04340509
439: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 04350509
440: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 04360509
441: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 04370509
442: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04380509
443: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04390509
444: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04400509
445: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04410509
446: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04420509
447: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 04430509
448: 21H(,F12.5,2H, ,F12.5,1H)) 04440509
449: CBE** ********************** BBCFMAT1 **********************************04450509
450: CBB** ********************** BBCFMT0B **********************************04460509
451: C**** FORMAT STATEMENTS FOR PAGE HEADERS 04470509
452: C**** 04480509
453: 90002 FORMAT (1H1) 04490509
454: 90004 FORMAT (1H ) 04500509
455: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 04510509
456: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04520509
457: 90008 FORMAT (1H ,21X,A13,A17) 04530509
458: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 04540509
459: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 04550509
460: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 04560509
461: 1 7X,7HREMARKS,24X) 04570509
462: 90014 FORMAT (1H ,46H----------------------------------------------, 04580509
463: 1 33H---------------------------------) 04590509
464: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 04600509
465: C**** 04610509
466: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04620509
467: C**** 04630509
468: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 04640509
469: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 04650509
470: 1 A13) 04660509
471: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 04670509
472: C**** 04680509
473: C**** FORMAT STATEMENTS FOR RUN SUMMARY 04690509
474: C**** 04700509
475: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 04710509
476: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 04720509
477: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 04730509
478: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 04740509
479: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 04750509
480: CBE** ********************** BBCFMT0B **********************************04760509
481: STOP 04770509
482: END 04780509
483: C 00010510
484: C DATE***82/08/02*18.33.46
485: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
486: C AUDIT FCVS78 V2.0
487: C THIS ROUTINE IS TO BE RUN WITH ROUTINE 509. 00020510
488: C 00030510
489: C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST IF 00040510
490: C MULTIPLE ENTRIES ARE PERMITTED IN A SUBROUTINE SUBPROGRAM. 00050510
491: C 00060510
492: SUBROUTINE SN510(IVD021,IVD002) 00070*TI
493: INTEGER I2D001(2,2) 00080510
494: COMMON IVC001, IVC002, IVC003 00090510
495: IVD001 = IVD021 00090*TI
496: DO 70010 IVN001 = 1, 3 00100510
497: IVD001 = IVD001 + 1 00110510
498: 70010 CONTINUE 00120510
499: IVD002 = IVD001 00130510
500: RETURN 00140510
501: ENTRY EN851(IVD003,IVD004) 00150510
502: IVD004 = 3*IVD003 + 7 00160510
503: RETURN 00170510
504: ENTRY EN852(IVD005) 00180510
505: IVD005 = IVD005 + 100 00190510
506: RETURN 00200510
507: ENTRY EN853(IVD006,IVD007) 00210510
508: IVD007 = 5*(IVD006 + 2) - 16 00220510
509: RETURN 00230510
510: ENTRY EN854(IVD008,IVD009,IVD010) 00240510
511: IVD010 = 4*(IVD008 - 2*IVD009) + 5 00250510
512: RETURN 00260510
513: ENTRY EN855(IVD011, IVD012, IVD013, IVD014) 00270510
514: IVD014 = IVD013*(2*IVD011 + IVD012) 00280510
515: RETURN 00290510
516: ENTRY EN856(IVD015,I2D001,IVD016) 00300510
517: IVD016 = 0 00310510
518: DO 70020 IVN001 = 1, IVD015 00320510
519: DO 70020 IVN002 = 1, IVD015 00330510
520: 70020 IVD016 = IVD016 + I2D001(IVN001,IVN002) 00340510
521: RETURN 00350510
522: ENTRY EN857(RVD017,RVD018,RFD001) 00360510
523: RVD018 = RFD001(RVD017) 00370510
524: RETURN 00380510
525: ENTRY EN858(IVD019,*,*) 00390510
526: RETURN IVD019 00400510
527: ENTRY EN859( ) 00410510
528: IVC001 = IVC002 + IVC003 00420510
529: RETURN 00430510
530: ENTRY EN860 00440510
531: IVC003 = IVC001 + IVC002 00450510
532: RETURN 00460510
533: END 00470510
534: C 00480510
535: C 00010511
536: C DATE***82/08/02*18.33.46
537: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
538: C AUDIT FCVS78 V2.0
539: C THIS ROUTINE IS TO BE RUN WITH ROUTINE 509. 00020511
540: C 00030511
541: C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE 00040511
542: C OF A SUBSTRING NAME AS AN ACTUAL ARGUMENT WHICH IS 00050511
543: C ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIBLE 00060511
544: C 00070511
545: SUBROUTINE SN511(CVD001,CVD002) 00080511
546: CHARACTER CVD001*6, CVD002*12 00090511
547: CVD002 = 'COLOR='//CVD001 00100511
548: RETURN 00110511
549: END 00120511
550: C 00010512
551: C DATE***82/08/02*18.33.46
552: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
553: C AUDIT FCVS78 V2.0
554: C THIS ROUTINE IS TO BE RUN WIHT ROUTINE 509. 00020512
555: C 00030512
556: C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE OF 00040512
557: C AN ARRAY ELEMENT SUBSTRING AS AN ACTUAL ARGUMENT WHICH 00050512
558: C IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS AN ARRAY. 00060512
559: C 00070512
560: SUBROUTINE SN512(C1D001,CVD001) 00080512
561: CHARACTER C1D001(6)*8,CVD001*8 00090512
562: CVD001 = C1D001(1) 00100512
563: RETURN 00110512
564: END 00120512
565: C 00010513
566: C DATE***82/08/02*18.33.46
567: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/
568: C AUDIT FCVS78 V2.0
569: C THIS FUNCTION IS TO BE RUN WITH ROUTINE 509. 00020513
570: C 00030513
571: C THIS FUNCTION IS REFERENCED IN THE MAIN PROGRAM TO TEST IF 00040513
572: C MULTIPLE ENTRIES ARE PERMITTED IN A FUNCTION SUBPROGRAM. 00050513
573: C 00060513
574: FUNCTION RF513(RVD001) 00070513
575: RF513 = RVD001**2 00080513
576: RETURN 00090513
577: ENTRY EF852(RVD002) 00100513
578: EF852 = 3*RVD002 00110513
579: RETURN 00120513
580: END 00130513
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.