![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM808.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 FM808.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***********************************************************************00010808
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 00020808
6: C***** FM808 YDBLE - (169) 00030808
7: C***** 00040808
8: C***********************************************************************00050808
9: C***** GENERAL PURPOSE ANS REF 00060808
10: C***** TEST INTRINSIC FUNCTION DBLE (EXPRESS S.P. ARGUMENT 15.3 00070808
11: C***** IN DOUBLE PRECISION FORM ) (TABLE 5)00080808
12: C***** 00090808
13: CBB** ********************** BBCCOMNT **********************************00100808
14: C**** 00110808
15: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120808
16: C**** VERSION 2.0 00130808
17: C**** 00140808
18: C**** 00150808
19: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160808
20: C**** GENERAL SERVICES ADMINISTRATION 00170808
21: C**** FEDERAL SOFTWARE TESTING CENTER 00180808
22: C**** 5203 LEESBURG PIKE, SUITE 1100 00190808
23: C**** FALLS CHURCH, VA. 22041 00200808
24: C**** 00210808
25: C**** (703) 756-6153 00220808
26: C**** 00230808
27: CBE** ********************** BBCCOMNT **********************************00240808
28: C***** 00250808
29: C***** S P E C I F I C A T I O N S SEGMENT 169 00260808
30: DOUBLE PRECISION DVAVD, DVBVD, DVCORR, DVAVD1 00270808
31: C***** 00280808
32: CBB** ********************** BBCINITA **********************************00290808
33: C**** SPECIFICATION STATEMENTS 00300808
34: C**** 00310808
35: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320808
36: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330808
37: CBE** ********************** BBCINITA **********************************00340808
38: CBB** ********************** BBCINITB **********************************00350808
39: C**** INITIALIZE SECTION 00360808
40: DATA ZVERS, ZVERSD, ZDATE 00370808
41: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00380808
42: DATA ZCOMPL, ZNAME, ZTAPE 00390808
43: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400808
44: DATA ZPROJ, ZTAPED, ZPROG 00410808
45: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420808
46: DATA REMRKS /' '/ 00430808
47: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440808
48: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450808
49: C**** 00460808
50: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470808
51: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480808
52: CZ03 ZPROG = 'PROGRAM NAME' 00490808
53: ZDATE = '07-Nov-85 ' *RP
54: ZCOMPL = 'CCI 5.2 ' *RP
55: ZPROJ = 'TC-85- -410' *RP
56: ZNAME = ' ' *RP
57: ZTAPE = ' ' *RP
58: ZTAPED = '850703 ' *RP
59: C 00560808
60: IVPASS = 0 00570808
61: IVFAIL = 0 00580808
62: IVDELE = 0 00590808
63: IVINSP = 0 00600808
64: IVTOTL = 0 00610808
65: IVTOTN = 0 00620808
66: ICZERO = 0 00630808
67: C 00640808
68: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650808
69: I01 = 05 00660808
70: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670808
71: I02 = 06 00680808
72: C 00690808
73: I01 = 5 00700808
74: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710808
75: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720808
76: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730808
77: C 00740808
78: I02 = 6 00750808
79: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760808
80: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770808
81: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780808
82: C 00790808
83: CBE** ********************** BBCINITB **********************************00800808
84: NUVI = I02 00810808
85: IVTOTL = 8 00820808
86: ZPROG = 'FM808' 00830808
87: CBB** ********************** BBCHED0A **********************************00840808
88: C**** 00850808
89: C**** WRITE REPORT TITLE 00860808
90: C**** 00870808
91: WRITE (I02, 90002) 00880808
92: WRITE (I02, 90006) 00890808
93: WRITE (I02, 90007) 00900808
94: WRITE (I02, 90008) ZVERS, ZVERSD 00910808
95: WRITE (I02, 90009) ZPROG, ZPROG 00920808
96: WRITE (I02, 90010) ZDATE, ZCOMPL 00930808
97: CBE** ********************** BBCHED0A **********************************00940808
98: C***** 00950808
99: WRITE (NUVI,16901) 00960808
100: 16901 FORMAT(1H ,//1X,34HYDBLE - (169) INTRINSIC FUNCTION--// 00970808
101: 1 16X,22HDBLE (TYPE CONVERSION)// 2X, 00980808
102: 2 15HANS REF. - 15.3) 00990808
103: CBB** ********************** BBCHED0B **********************************01000808
104: C**** WRITE DETAIL REPORT HEADERS 01010808
105: C**** 01020808
106: WRITE (I02,90004) 01030808
107: WRITE (I02,90004) 01040808
108: WRITE (I02,90013) 01050808
109: WRITE (I02,90014) 01060808
110: WRITE (I02,90015) IVTOTL 01070808
111: CBE** ********************** BBCHED0B **********************************01080808
112: C***** 01090808
113: CT001* TEST 1 THE VALUE ZERO 01100808
114: IVTNUM = 1 01110808
115: RVAVS = 0.0 01120808
116: DVAVD = DBLE(RVAVS) 01130808
117: IF (DVAVD + 5.0D-5) 20010, 10010, 40010 01140808
118: 40010 IF (DVAVD - 5.0D-5) 10010, 10010, 20010 01150808
119: 10010 IVPASS = IVPASS + 1 01160808
120: WRITE (NUVI, 80002) IVTNUM 01170808
121: GO TO 0011 01180808
122: 20010 IVFAIL = IVFAIL + 1 01190808
123: DVCORR = 0.0D0 01200808
124: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01210808
125: 0011 CONTINUE 01220808
126: CT002* TEST 2 A D.P. CONSTANT WITH 6 SIGNIFICANT DIGITS 01230808
127: IVTNUM = 2 01240808
128: RVAVS = 0.015625 01250808
129: DVAVD = DBLE(RVAVS) 01260808
130: IF (DVAVD - 1.5624D-2) 20020, 10020, 40020 01270808
131: 40020 IF (DVAVD - 1.5626D-2) 10020, 10020, 20020 01280808
132: 10020 IVPASS = IVPASS + 1 01290808
133: WRITE (NUVI, 80002) IVTNUM 01300808
134: GO TO 0021 01310808
135: 20020 IVFAIL = IVFAIL + 1 01320808
136: DVCORR = 1.5625D-2 01330808
137: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01340808
138: 0021 CONTINUE 01350808
139: CT003* TEST 3 A NEGATIVE INTEGRAL VALUE 01360808
140: IVTNUM = 3 01370808
141: RVAVS = -321.0 01380808
142: DVAVD = DBLE(RVAVS) 01390808
143: IF (DVAVD + 3.2102D2) 20030, 10030, 40030 01400808
144: 40030 IF (DVAVD + 3.2098D2) 10030, 10030, 20030 01410808
145: 10030 IVPASS = IVPASS + 1 01420808
146: WRITE (NUVI, 80002) IVTNUM 01430808
147: GO TO 0031 01440808
148: 20030 IVFAIL = IVFAIL + 1 01450808
149: DVCORR = -3.210D2 01460808
150: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01470808
151: 0031 CONTINUE 01480808
152: CT004* TEST 4 A NEGATIVE D.P. CONSTANT WITH 6 SIGNIFICANT DIGITS 01490808
153: IVTNUM = 4 01500808
154: RVAVS = -0.015625 01510808
155: DVAVD = DBLE(RVAVS) 01520808
156: IF (DVAVD + 1.5626D-2) 20040, 10040, 40040 01530808
157: 40040 IF (DVAVD + 1.5624D-2) 10040, 10040, 20040 01540808
158: 10040 IVPASS = IVPASS + 1 01550808
159: WRITE (NUVI, 80002) IVTNUM 01560808
160: GO TO 0041 01570808
161: 20040 IVFAIL = IVFAIL + 1 01580808
162: DVCORR = -0.015625D0 01590808
163: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01600808
164: 0041 CONTINUE 01610808
165: CT005* TEST 5 THE VALUE ZERO PRECEDED BY A MINUS SIGN 01620808
166: IVTNUM = 5 01630808
167: RVAVS = 0.0 01640808
168: DVAVD = DBLE(-RVAVS) 01650808
169: IF (DVAVD + 5.0D-5) 20050, 10050, 40050 01660808
170: 40050 IF (DVAVD - 5.0D-5) 10050, 10050, 20050 01670808
171: 10050 IVPASS = IVPASS + 1 01680808
172: WRITE (NUVI, 80002) IVTNUM 01690808
173: GO TO 0051 01700808
174: 20050 IVFAIL = IVFAIL + 1 01710808
175: DVCORR = -0.0D0 01720808
176: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01730808
177: 0051 CONTINUE 01740808
178: CT006* TEST 6 A POSITIVE INTEGRAL VALUE 01750808
179: IVTNUM = 6 01760808
180: RVAVS = 321.0 01770808
181: DVAVD = DBLE(RVAVS) 01780808
182: IF (DVAVD - 3.2098D2) 20060, 10060, 40060 01790808
183: 40060 IF (DVAVD - 3.2102D2) 10060, 10060, 20060 01800808
184: 10060 IVPASS = IVPASS + 1 01810808
185: WRITE (NUVI, 80002) IVTNUM 01820808
186: GO TO 0061 01830808
187: 20060 IVFAIL = IVFAIL + 1 01840808
188: DVCORR = 3.21D2 01850808
189: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01860808
190: 0061 CONTINUE 01870808
191: CT007* TEST 7 AN ARITHMETIC EXPRESSION IS USED AS ARGUMENT 01880808
192: IVTNUM = 7 01890808
193: RVAVS = 6.25 01900808
194: RVBVS = 2.5 01910808
195: DVAVD = DBLE(RVBVS ** 2) 01920808
196: IF (DVAVD - 6.2496D0) 20070, 10070, 40070 01930808
197: 40070 IF (DVAVD - 6.2504D0) 10070, 10070, 20070 01940808
198: 10070 IVPASS = IVPASS + 1 01950808
199: WRITE (NUVI, 80002) IVTNUM 01960808
200: GO TO 0071 01970808
201: 20070 IVFAIL = IVFAIL + 1 01980808
202: DVCORR = 6.25D0 01990808
203: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 02000808
204: 0071 CONTINUE 02010808
205: CT008* TEST 8 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT 02020808
206: IVTNUM = 8 02030808
207: RVBVS = 2.5 02040808
208: DVBVD = RVBVS ** 3 02050808
209: DVAVD = DBLE(RVBVS ** 3) 02060808
210: IF (DVAVD - 1.5624D1) 20080, 10080, 40080 02070808
211: 40080 IF (DVAVD - 1.5626D1) 10080, 10080, 20080 02080808
212: 10080 IVPASS = IVPASS + 1 02090808
213: WRITE (NUVI, 80002) IVTNUM 02100808
214: GO TO 0081 02110808
215: 20080 IVFAIL = IVFAIL + 1 02120808
216: DVCORR = 1.5625D1 02130808
217: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 02140808
218: 0081 CONTINUE 02150808
219: CBB** ********************** BBCSUM0 **********************************02160808
220: C**** WRITE OUT TEST SUMMARY 02170808
221: C**** 02180808
222: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02190808
223: WRITE (I02, 90004) 02200808
224: WRITE (I02, 90014) 02210808
225: WRITE (I02, 90004) 02220808
226: WRITE (I02, 90020) IVPASS 02230808
227: WRITE (I02, 90022) IVFAIL 02240808
228: WRITE (I02, 90024) IVDELE 02250808
229: WRITE (I02, 90026) IVINSP 02260808
230: WRITE (I02, 90028) IVTOTN, IVTOTL 02270808
231: CBE** ********************** BBCSUM0 **********************************02280808
232: CBB** ********************** BBCFOOT0 **********************************02290808
233: C**** WRITE OUT REPORT FOOTINGS 02300808
234: C**** 02310808
235: WRITE (I02,90016) ZPROG, ZPROG 02320808
236: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02330808
237: WRITE (I02,90019) 02340808
238: CBE** ********************** BBCFOOT0 **********************************02350808
239: CBB** ********************** BBCFMT0A **********************************02360808
240: C**** FORMATS FOR TEST DETAIL LINES 02370808
241: C**** 02380808
242: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 02390808
243: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 02400808
244: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 02410808
245: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 02420808
246: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 02430808
247: 1I6,/,1H ,15X,10HCORRECT= ,I6) 02440808
248: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02450808
249: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 02460808
250: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02470808
251: 1A21,/,1H ,16X,10HCORRECT= ,A21) 02480808
252: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 02490808
253: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 02500808
254: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 02510808
255: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 02520808
256: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 02530808
257: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 02540808
258: 80050 FORMAT (1H ,48X,A31) 02550808
259: CBE** ********************** BBCFMT0A **********************************02560808
260: CBB** ********************** BBCFMAT1 **********************************02570808
261: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02580808
262: C**** 02590808
263: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02600808
264: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 02610808
265: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 02620808
266: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 02630808
267: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 02640808
268: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 02650808
269: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 02660808
270: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 02670808
271: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02680808
272: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 02690808
273: 21H(,F12.5,2H, ,F12.5,1H)) 02700808
274: CBE** ********************** BBCFMAT1 **********************************02710808
275: CBB** ********************** BBCFMT0B **********************************02720808
276: C**** FORMAT STATEMENTS FOR PAGE HEADERS 02730808
277: C**** 02740808
278: 90002 FORMAT (1H1) 02750808
279: 90004 FORMAT (1H ) 02760808
280: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 02770808
281: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02780808
282: 90008 FORMAT (1H ,21X,A13,A17) 02790808
283: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 02800808
284: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 02810808
285: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 02820808
286: 1 7X,7HREMARKS,24X) 02830808
287: 90014 FORMAT (1H ,46H----------------------------------------------, 02840808
288: 1 33H---------------------------------) 02850808
289: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 02860808
290: C**** 02870808
291: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02880808
292: C**** 02890808
293: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 02900808
294: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 02910808
295: 1 A13) 02920808
296: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 02930808
297: C**** 02940808
298: C**** FORMAT STATEMENTS FOR RUN SUMMARY 02950808
299: C**** 02960808
300: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 02970808
301: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 02980808
302: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 02990808
303: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 03000808
304: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 03010808
305: CBE** ********************** BBCFMT0B **********************************03020808
306: C***** 03030808
307: C***** END OF TEST SEGMENT 169 03040808
308: STOP 03050808
309: END 03060808
310: 03070808
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.