|
|
1.1 root 1: C***********************************************************************00010804
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 00020804
6: C***** FM804 YDMOD - (160) 00030804
7: C***** 00040804
8: C***********************************************************************00050804
9: C***** GENERAL PURPOSE ANS REF 00060804
10: C***** TO TEST INTRINSIC FUNCTION - DMOD - 15.3 00070804
11: C***** (REMAINDERING -TYPE DOUBLE PRECISION) (TABLE 5)00080804
12: CBB** ********************** BBCCOMNT **********************************00090804
13: C**** 00100804
14: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00110804
15: C**** VERSION 2.0 00120804
16: C**** 00130804
17: C**** 00140804
18: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00150804
19: C**** GENERAL SERVICES ADMINISTRATION 00160804
20: C**** FEDERAL SOFTWARE TESTING CENTER 00170804
21: C**** 5203 LEESBURG PIKE, SUITE 1100 00180804
22: C**** FALLS CHURCH, VA. 22041 00190804
23: C**** 00200804
24: C**** (703) 756-6153 00210804
25: C**** 00220804
26: CBE** ********************** BBCCOMNT **********************************00230804
27: C***** 00240804
28: C***** S P E C I F I C A T I O N S SEGMENT 160 00250804
29: C***** 00260804
30: DOUBLE PRECISION DQAVD, DQBVD, DQDVD, DQEVD, DQFVD 00270804
31: C***** 00280804
32: CBB** ********************** BBCINITA **********************************00290804
33: C**** SPECIFICATION STATEMENTS 00300804
34: C**** 00310804
35: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320804
36: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330804
37: CBE** ********************** BBCINITA **********************************00340804
38: CBB** ********************** BBCINITB **********************************00350804
39: C**** INITIALIZE SECTION 00360804
40: DATA ZVERS, ZVERSD, ZDATE 00370804
41: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00380804
42: DATA ZCOMPL, ZNAME, ZTAPE 00390804
43: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400804
44: DATA ZPROJ, ZTAPED, ZPROG 00410804
45: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420804
46: DATA REMRKS /' '/ 00430804
47: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440804
48: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450804
49: C**** 00460804
50: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470804
51: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480804
52: CZ03 ZPROG = 'PROGRAM NAME' 00490804
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 00560804
60: IVPASS = 0 00570804
61: IVFAIL = 0 00580804
62: IVDELE = 0 00590804
63: IVINSP = 0 00600804
64: IVTOTL = 0 00610804
65: IVTOTN = 0 00620804
66: ICZERO = 0 00630804
67: C 00640804
68: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650804
69: I01 = 05 00660804
70: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670804
71: I02 = 06 00680804
72: C 00690804
73: I01 = 5 00700804
74: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710804
75: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720804
76: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730804
77: C 00740804
78: I02 = 6 00750804
79: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760804
80: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770804
81: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780804
82: C 00790804
83: CBE** ********************** BBCINITB **********************************00800804
84: NUVI = I02 00810804
85: IVTOTL = 11 00820804
86: ZPROG = 'FM804' 00830804
87: CBB** ********************** BBCHED0A **********************************00840804
88: C**** 00850804
89: C**** WRITE REPORT TITLE 00860804
90: C**** 00870804
91: WRITE (I02, 90002) 00880804
92: WRITE (I02, 90006) 00890804
93: WRITE (I02, 90007) 00900804
94: WRITE (I02, 90008) ZVERS, ZVERSD 00910804
95: WRITE (I02, 90009) ZPROG, ZPROG 00920804
96: WRITE (I02, 90010) ZDATE, ZCOMPL 00930804
97: CBE** ********************** BBCHED0A **********************************00940804
98: C***** 00950804
99: C***** HEADER FOR SEGMENT 160 00960804
100: WRITE (NUVI, 16001) 00970804
101: 16001 FORMAT( 1H , //35H YDMOD - (160) INTRINSIC FUNCTION--// 00980804
102: 1 16X,19HDMOD (REMAINDERING) // 00990804
103: 2 19H ANS REF. - 15.3 ) 01000804
104: CBB** ********************** BBCHED0B **********************************01010804
105: C**** WRITE DETAIL REPORT HEADERS 01020804
106: C**** 01030804
107: WRITE (I02,90004) 01040804
108: WRITE (I02,90004) 01050804
109: WRITE (I02,90013) 01060804
110: WRITE (I02,90014) 01070804
111: WRITE (I02,90015) IVTOTL 01080804
112: CBE** ********************** BBCHED0B **********************************01090804
113: C***** 01100804
114: CT001* TEST 1 FIRST VALUE ZERO, SECOND NON-ZERO 01110804
115: IVTNUM = 1 01120804
116: DQBVD = 0.0D0 01130804
117: DQDVD = 4.5D0 01140804
118: DQAVD = DMOD(DQBVD, DQDVD) 01150804
119: IF (DQAVD + 5.0D-10) 20010, 10010, 40010 01160804
120: 40010 IF (DQAVD - 5.0D-10) 10010, 10010, 20010 01170804
121: 10010 IVPASS = IVPASS + 1 01180804
122: WRITE (NUVI, 80002) IVTNUM 01190804
123: GO TO 0011 01200804
124: 20010 IVFAIL = IVFAIL + 1 01210804
125: DVCORR = 0.0D0 01220804
126: WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01230804
127: 0011 CONTINUE 01240804
128: CT002* TEST 2 BOTH VALUES EQUAL 01250804
129: IVTNUM = 2 01260804
130: DQBVD = 0.35D1 01270804
131: DQDVD = 0.35D1 01280804
132: DQAVD = DMOD(DQBVD, DQDVD) 01290804
133: IF (DQAVD + 5.0D-10) 20020, 10020, 40020 01300804
134: 40020 IF (DQAVD - 5.0D-10) 10020, 10020, 20020 01310804
135: 10020 IVPASS = IVPASS + 1 01320804
136: WRITE (NUVI, 80002) IVTNUM 01330804
137: GO TO 0021 01340804
138: 20020 IVFAIL = IVFAIL + 1 01350804
139: DVCORR = 0.0D0 01360804
140: WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01370804
141: 0021 CONTINUE 01380804
142: CT003* TEST 3 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND 01390804
143: IVTNUM = 3 01400804
144: DQBVD = -0.10D2 01410804
145: DQDVD = -0.3D1 01420804
146: DQAVD = DMOD(DQBVD, DQDVD) 01430804
147: IF (DQAVD + 1.000000001D0) 20030, 10030, 40030 01440804
148: 40030 IF (DQAVD + 0.9999999995D0) 10030, 10030, 20030 01450804
149: 10030 IVPASS = IVPASS + 1 01460804
150: WRITE (NUVI, 80002) IVTNUM 01470804
151: GO TO 0031 01480804
152: 20030 IVFAIL = IVFAIL + 1 01490804
153: DVCORR = -1.0D0 01500804
154: WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01510804
155: 0031 CONTINUE 01520804
156: CT004* TEST 4 FIRST MAGNITUDE LARGER, MULTIPLE OF SECOND 01530804
157: IVTNUM = 4 01540804
158: DQDVD = 1.5D0 01550804
159: DQBVD = 1.5D0 + DQDVD + 1.5D0 01560804
160: DQAVD = DMOD(DQBVD, DQDVD) 01570804
161: IF (DQAVD + 5.0D-10) 20040, 10040, 40040 01580804
162: 40040 IF (DQAVD - 5.0D-10) 10040, 10040, 20040 01590804
163: 10040 IVPASS = IVPASS + 1 01600804
164: WRITE (NUVI, 80002) IVTNUM 01610804
165: GO TO 0041 01620804
166: 20040 IVFAIL = IVFAIL + 1 01630804
167: DVCORR = 0.0D0 01640804
168: WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01650804
169: 0041 CONTINUE 01660804
170: CT005* TEST 5 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND 01670804
171: IVTNUM = 5 01680804
172: DQBVD = 7.625D0 01690804
173: DQDVD = 2.125D0 01700804
174: DQAVD = DMOD(DQBVD, DQDVD) 01710804
175: IF (DQAVD - 1.249999999D0) 20050, 10050, 40050 01720804
176: 40050 IF (DQAVD - 1.250000001D0) 10050, 10050, 20050 01730804
177: 10050 IVPASS = IVPASS + 1 01740804
178: WRITE (NUVI, 80002) IVTNUM 01750804
179: GO TO 0051 01760804
180: 20050 IVFAIL = IVFAIL + 1 01770804
181: DVCORR = 1.25D0 01780804
182: WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01790804
183: 0051 CONTINUE 01800804
184: CT006* TEST 6 FIRST VALUE ZERO, SECOND NEGATIVE 01810804
185: IVTNUM = 6 01820804
186: DQBVD = 0.0D0 01830804
187: DQDVD = -0.45D1 01840804
188: DQAVD = DMOD(DQBVD, DQDVD) 01850804
189: IF (DQAVD + 5.0D-10) 20060, 10060, 40060 01860804
190: 40060 IF (DQAVD - 5.0D-10) 10060, 10060, 20060 01870804
191: 10060 IVPASS = IVPASS + 1 01880804
192: WRITE (NUVI, 80002) IVTNUM 01890804
193: GO TO 0061 01900804
194: 20060 IVFAIL = IVFAIL + 1 01910804
195: DVCORR = 0.0D0 01920804
196: WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01930804
197: 0061 CONTINUE 01940804
198: CT007* TEST 7 BOTH VALUES EQUAL, BOTH NEGATIVE 01950804
199: IVTNUM = 7 01960804
200: DQBVD = -3.5D1 01970804
201: DQDVD = -3.5D1 01980804
202: DQAVD = DMOD(DQBVD, DQDVD) 01990804
203: IF (DQAVD + 5.0D-10) 20070, 10070, 40070 02000804
204: 40070 IF (DQAVD - 5.0D-10) 10070, 10070, 20070 02010804
205: 10070 IVPASS = IVPASS + 1 02020804
206: WRITE (NUVI, 80002) IVTNUM 02030804
207: GO TO 0071 02040804
208: 20070 IVFAIL = IVFAIL + 1 02050804
209: DVCORR = 0.0D0 02060804
210: WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 02070804
211: 0071 CONTINUE 02080804
212: CT008* TEST 8 FIRST MAGNITUDE LARGER, MULIPLES, BOTH NEGATIVE 02090804
213: IVTNUM = 8 02100804
214: DQDVD = 3.5D0 02110804
215: DQBVD = -(3.5D0 + DQDVD + 3.5D0) 02120804
216: DQAVD = DMOD(DQBVD, -DQDVD) 02130804
217: IF (DQAVD + 5.0D-10) 20080, 10080, 40080 02140804
218: 40080 IF (DQAVD - 5.0D-10) 10080, 10080, 20080 02150804
219: 10080 IVPASS = IVPASS + 1 02160804
220: WRITE (NUVI, 80002) IVTNUM 02170804
221: GO TO 0081 02180804
222: 20080 IVFAIL = IVFAIL + 1 02190804
223: DVCORR = 0.0D0 02200804
224: WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 02210804
225: 0081 CONTINUE 02220804
226: CT009* TEST 9 FIRST VALUE POSITIVE, SECOND NEGATIVE, MULTIPLE 02230804
227: IVTNUM = 9 02240804
228: DQBVD = 10.5D0 02250804
229: DQDVD = -3.5D0 02260804
230: DQAVD = DMOD(DQBVD, DQDVD) 02270804
231: IF (DQAVD + 5.0D-10) 20090, 10090, 40090 02280804
232: 40090 IF (DQAVD - 5.0D-10) 10090, 10090, 20090 02290804
233: 10090 IVPASS = IVPASS + 1 02300804
234: WRITE (NUVI, 80002) IVTNUM 02310804
235: GO TO 0091 02320804
236: 20090 IVFAIL = IVFAIL + 1 02330804
237: DVCORR = 0.0D0 02340804
238: WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 02350804
239: 0091 CONTINUE 02360804
240: CT010* TEST 10 FIRST VALUE ZERO PRECEDED BY MINUS SIGN 02370804
241: IVTNUM = 10 02380804
242: DQDVD = 0.0D0 02390804
243: DQEVD = 4.5D0 02400804
244: DQAVD = DMOD(-DQDVD, DQEVD) 02410804
245: IF (DQAVD + 5.0D-10) 20100, 10100, 40100 02420804
246: 40100 IF (DQAVD - 5.0D-10) 10100, 10100, 20100 02430804
247: 10100 IVPASS = IVPASS + 1 02440804
248: WRITE (NUVI, 80002) IVTNUM 02450804
249: GO TO 0101 02460804
250: 20100 IVFAIL = IVFAIL + 1 02470804
251: DVCORR = 0.0D0 02480804
252: WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 02490804
253: 0101 CONTINUE 02500804
254: CT011* TEST 11 PAIR OF ARITHMETIC EXPRESSIONS USED AS ARGUMENT 02510804
255: IVTNUM = 11 02520804
256: DQDVD = 0.7625D1 02530804
257: DQEVD = 0.2125D1 02540804
258: DQFVD = 0.2D1 02550804
259: DQAVD = DMOD(DQDVD - DQFVD, DQEVD + DQFVD) 02560804
260: IF (DQAVD - 0.1499999999D1) 20110, 10110, 40110 02570804
261: 40110 IF (DQAVD - 0.1500000001D1) 10110, 10110, 20110 02580804
262: 10110 IVPASS = IVPASS + 1 02590804
263: WRITE (NUVI, 80002) IVTNUM 02600804
264: GO TO 0111 02610804
265: 20110 IVFAIL = IVFAIL + 1 02620804
266: DVCORR = 0.15D1 02630804
267: WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 02640804
268: 0111 CONTINUE 02650804
269: C***** 02660804
270: CBB** ********************** BBCSUM0 **********************************02670804
271: C**** WRITE OUT TEST SUMMARY 02680804
272: C**** 02690804
273: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02700804
274: WRITE (I02, 90004) 02710804
275: WRITE (I02, 90014) 02720804
276: WRITE (I02, 90004) 02730804
277: WRITE (I02, 90020) IVPASS 02740804
278: WRITE (I02, 90022) IVFAIL 02750804
279: WRITE (I02, 90024) IVDELE 02760804
280: WRITE (I02, 90026) IVINSP 02770804
281: WRITE (I02, 90028) IVTOTN, IVTOTL 02780804
282: CBE** ********************** BBCSUM0 **********************************02790804
283: CBB** ********************** BBCFOOT0 **********************************02800804
284: C**** WRITE OUT REPORT FOOTINGS 02810804
285: C**** 02820804
286: WRITE (I02,90016) ZPROG, ZPROG 02830804
287: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02840804
288: WRITE (I02,90019) 02850804
289: CBE** ********************** BBCFOOT0 **********************************02860804
290: CBB** ********************** BBCFMT0A **********************************02870804
291: C**** FORMATS FOR TEST DETAIL LINES 02880804
292: C**** 02890804
293: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 02900804
294: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 02910804
295: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 02920804
296: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 02930804
297: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 02940804
298: 1I6,/,1H ,15X,10HCORRECT= ,I6) 02950804
299: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02960804
300: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 02970804
301: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02980804
302: 1A21,/,1H ,16X,10HCORRECT= ,A21) 02990804
303: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 03000804
304: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 03010804
305: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 03020804
306: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 03030804
307: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 03040804
308: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 03050804
309: 80050 FORMAT (1H ,48X,A31) 03060804
310: CBE** ********************** BBCFMT0A **********************************03070804
311: CBB** ********************** BBCFMAT1 **********************************03080804
312: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03090804
313: C**** 03100804
314: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 03110804
315: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 03120804
316: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 03130804
317: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 03140804
318: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 03150804
319: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 03160804
320: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 03170804
321: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 03180804
322: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 03190804
323: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 03200804
324: 21H(,F12.5,2H, ,F12.5,1H)) 03210804
325: CBE** ********************** BBCFMAT1 **********************************03220804
326: CBB** ********************** BBCFMT0B **********************************03230804
327: C**** FORMAT STATEMENTS FOR PAGE HEADERS 03240804
328: C**** 03250804
329: 90002 FORMAT (1H1) 03260804
330: 90004 FORMAT (1H ) 03270804
331: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 03280804
332: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03290804
333: 90008 FORMAT (1H ,21X,A13,A17) 03300804
334: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 03310804
335: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 03320804
336: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 03330804
337: 1 7X,7HREMARKS,24X) 03340804
338: 90014 FORMAT (1H ,46H----------------------------------------------, 03350804
339: 1 33H---------------------------------) 03360804
340: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 03370804
341: C**** 03380804
342: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03390804
343: C**** 03400804
344: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 03410804
345: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 03420804
346: 1 A13) 03430804
347: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 03440804
348: C**** 03450804
349: C**** FORMAT STATEMENTS FOR RUN SUMMARY 03460804
350: C**** 03470804
351: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 03480804
352: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 03490804
353: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 03500804
354: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 03510804
355: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 03520804
356: CBE** ********************** BBCFMT0B **********************************03530804
357: C***** 03540804
358: C***** END OF TEST SEGMENT 160 03550804
359: STOP 03560804
360: END 03570804
361: 03580804
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.