![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm021.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests|
Return to fm021.f CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests |
1.1 root 1: c
2: c comment section.
3: c
4: c fm021
5: c
6: c this routine tests the fortran data initialization
7: c statement. integer, real, and logical data types are tested
8: c using unsigned constants, signed constants, and logical
9: c constants.. integer, real, logical, and mixed type arrays
10: c are also tested.
11: c
12: c references
13: c american national standard programming language fortran,
14: c x3.9-1978
15: c
16: c section 4.1.3, data type preparation
17: c section 4.4.3, real constant
18: c section 9, data statement
19: c
20: integer ratn11(3)
21: logical lctn01, lctn02, latn11(3), ladn11
22: real iatn11(3)
23: dimension iadn11(3), radn11(4), ladn11(6), radn13(4), iadn12(4)
24: dimension iadn13(4)
25: c
26: data icon01/0/
27: data icon02/3/
28: data icon03/76/
29: data icon04/587/
30: data icon05/9999/
31: data icon06/32767/
32: data icon07/-0/
33: data icon08/-32766/
34: data icon09/00003/
35: data icon10/ 3 2 7 6 7 /
36: data lctn01/.true./
37: data lctn02/.false./
38: data rcon01/0./
39: data rcon02 /.0/
40: data rcon03/0.0/
41: data rcon04/32767./
42: data rcon05/-32766./
43: data rcon06/-000587./
44: data rcon07/99.99/
45: data rcon08/ -03. 2 7 6 6/
46: data iadn11(1)/3/, iadn11(3)/-587/, iadn11(2)/32767/
47: data iadn12/4*9999/
48: data iadn13/0,2*-32766,-587/
49: data ladn11/.true., .false., 2*.true., 2*.false./
50: data radn11/32767., -32.766, 2*587./
51: data latn11/.true., 2*.false./, iatn11/2*32767., -32766./
52: data ratn11/3*-32766/
53: data radn13/32.767e03, -3.2766e-01, .587e+03, 9e1/
54: c
55: c
56: c **********************************************************
57: c
58: c a compiler validation system for the fortran language
59: c based on specifications as defined in american national standard
60: c programming language fortran x3.9-1978, has been developed by the
61: c federal cobol compiler testing service. the fortran compiler
62: c validation system (fcvs) consists of audit routines, their related
63: c data, and an executive system. each audit routine is a fortran
64: c program, subprogram or function which includes tests of specific
65: c language elements and supporting procedures indicating the result
66: c of executing these tests.
67: c
68: c this particular program/subprogram/function contains features
69: c found only in the subset as defined in x3.9-1978.
70: c
71: c suggestions and comments should be forwarded to -
72: c
73: c department of the navy
74: c federal cobol compiler testing service
75: c washington, d.c. 20376
76: c
77: c **********************************************************
78: c
79: c
80: c
81: c initialization section
82: c
83: c initialize constants
84: c **************
85: c i01 contains the logical unit number for the card reader.
86: i01 = 5
87: c i02 contains the logical unit number for the printer.
88: i02 = 6
89: c system environment section
90: c
91: cx010 this card is replaced by contents of fexec x-010 control card.
92: c the cx010 card is for overriding the program default i01 = 5
93: c (unit number for card reader).
94: cx011 this card is replaced by contents of fexec x-011 control card.
95: c the cx011 card is for systems which require additional
96: c fortran statements for files associated with cx010 above.
97: c
98: cx020 this card is replaced by contents of fexec x-020 control card.
99: c the cx020 card is for overriding the program default i02 = 6
100: c (unit number for printer).
101: cx021 this card is replaced by contents of fexec x-021 control card.
102: c the cx021 card is for systems which require additional
103: c fortran statements for files associated with cx020 above.
104: c
105: ivpass=0
106: ivfail=0
107: ivdele=0
108: iczero=0
109: c
110: c write page headers
111: write (i02,90000)
112: write (i02,90001)
113: write (i02,90002)
114: write (i02, 90002)
115: write (i02,90003)
116: write (i02,90002)
117: write (i02,90004)
118: write (i02,90002)
119: write (i02,90011)
120: write (i02,90002)
121: write (i02,90002)
122: write (i02,90005)
123: write (i02,90006)
124: write (i02,90002)
125: ivtnum = 565
126: c
127: c **** test 565 ****
128: c test 565 - test of an integer variable set to the integer
129: c constant zero.
130: c
131: c
132: if (iczero) 35650, 5650, 35650
133: 5650 continue
134: go to 45650
135: 35650 ivdele = ivdele + 1
136: write (i02,80003) ivtnum
137: if (iczero) 45650, 5661, 45650
138: 45650 if ( icon01 - 0 ) 25650, 15650, 25650
139: 15650 ivpass = ivpass + 1
140: write (i02,80001) ivtnum
141: go to 5661
142: 25650 ivfail = ivfail + 1
143: ivcomp = icon01
144: ivcorr = 0
145: write (i02,80004) ivtnum, ivcomp ,ivcorr
146: 5661 continue
147: ivtnum = 566
148: c
149: c **** test 566 ****
150: c test 566 - test of an integer variable set to the integer
151: c constant 3.
152: c
153: c
154: if (iczero) 35660, 5660, 35660
155: 5660 continue
156: go to 45660
157: 35660 ivdele = ivdele + 1
158: write (i02,80003) ivtnum
159: if (iczero) 45660, 5671, 45660
160: 45660 if ( icon02 - 3 ) 25660, 15660, 25660
161: 15660 ivpass = ivpass + 1
162: write (i02,80001) ivtnum
163: go to 5671
164: 25660 ivfail = ivfail + 1
165: ivcomp = icon02
166: ivcorr = 3
167: write (i02,80004) ivtnum, ivcomp ,ivcorr
168: 5671 continue
169: ivtnum = 567
170: c
171: c **** test 567 ****
172: c test 567 - test of an integer variable set to the integer
173: c constant 76.
174: c
175: c
176: if (iczero) 35670, 5670, 35670
177: 5670 continue
178: go to 45670
179: 35670 ivdele = ivdele + 1
180: write (i02,80003) ivtnum
181: if (iczero) 45670, 5681, 45670
182: 45670 if ( icon03 - 76 ) 25670, 15670, 25670
183: 15670 ivpass = ivpass + 1
184: write (i02,80001) ivtnum
185: go to 5681
186: 25670 ivfail = ivfail + 1
187: ivcomp = icon03
188: ivcorr = 76
189: write (i02,80004) ivtnum, ivcomp ,ivcorr
190: 5681 continue
191: ivtnum = 568
192: c
193: c **** test 568 ****
194: c test 568 - test of an integer variable set to the integer
195: c constant 587.
196: c
197: c
198: if (iczero) 35680, 5680, 35680
199: 5680 continue
200: go to 45680
201: 35680 ivdele = ivdele + 1
202: write (i02,80003) ivtnum
203: if (iczero) 45680, 5691, 45680
204: 45680 if ( icon04 - 587 ) 25680, 15680, 25680
205: 15680 ivpass = ivpass + 1
206: write (i02,80001) ivtnum
207: go to 5691
208: 25680 ivfail = ivfail + 1
209: ivcomp = icon04
210: ivcorr = 587
211: write (i02,80004) ivtnum, ivcomp ,ivcorr
212: 5691 continue
213: ivtnum = 569
214: c
215: c **** test 569 ****
216: c test 569 - test of an integer variable set to the integer
217: c constant 9999.
218: c
219: c
220: if (iczero) 35690, 5690, 35690
221: 5690 continue
222: go to 45690
223: 35690 ivdele = ivdele + 1
224: write (i02,80003) ivtnum
225: if (iczero) 45690, 5701, 45690
226: 45690 if ( icon05 - 9999 ) 25690, 15690, 25690
227: 15690 ivpass = ivpass + 1
228: write (i02,80001) ivtnum
229: go to 5701
230: 25690 ivfail = ivfail + 1
231: ivcomp = icon05
232: ivcorr = 9999
233: write (i02,80004) ivtnum, ivcomp ,ivcorr
234: 5701 continue
235: ivtnum = 570
236: c
237: c **** test 570 ****
238: c test 570 - test of an integer variable set to the integer
239: c constant 32767.
240: c
241: c
242: if (iczero) 35700, 5700, 35700
243: 5700 continue
244: go to 45700
245: 35700 ivdele = ivdele + 1
246: write (i02,80003) ivtnum
247: if (iczero) 45700, 5711, 45700
248: 45700 if ( icon06 - 32767 ) 25700, 15700, 25700
249: 15700 ivpass = ivpass + 1
250: write (i02,80001) ivtnum
251: go to 5711
252: 25700 ivfail = ivfail + 1
253: ivcomp = icon06
254: ivcorr = 32767
255: write (i02,80004) ivtnum, ivcomp ,ivcorr
256: 5711 continue
257: ivtnum = 571
258: c
259: c **** test 571 ****
260: c test 571 - test of an integer variable set to the integer
261: c constant -0. note that signed zero and unsigned zero
262: c should be equal for any integer operation.
263: c
264: c
265: if (iczero) 35710, 5710, 35710
266: 5710 continue
267: go to 45710
268: 35710 ivdele = ivdele + 1
269: write (i02,80003) ivtnum
270: if (iczero) 45710, 5721, 45710
271: 45710 if ( icon07 - 0 ) 25710, 15710, 25710
272: 15710 ivpass = ivpass + 1
273: write (i02,80001) ivtnum
274: go to 5721
275: 25710 ivfail = ivfail + 1
276: ivcomp = icon07
277: ivcorr = -0
278: write (i02,80004) ivtnum, ivcomp ,ivcorr
279: 5721 continue
280: ivtnum = 572
281: c
282: c **** test 572 ****
283: c test 572 - test of an integer variable set to the integer
284: c constant (signed) -32766.
285: c
286: c
287: if (iczero) 35720, 5720, 35720
288: 5720 continue
289: go to 45720
290: 35720 ivdele = ivdele + 1
291: write (i02,80003) ivtnum
292: if (iczero) 45720, 5731, 45720
293: 45720 if ( icon08 + 32766 ) 25720, 15720, 25720
294: 15720 ivpass = ivpass + 1
295: write (i02,80001) ivtnum
296: go to 5731
297: 25720 ivfail = ivfail + 1
298: ivcomp = icon08
299: ivcorr = -32766
300: write (i02,80004) ivtnum, ivcomp ,ivcorr
301: 5731 continue
302: ivtnum = 573
303: c
304: c **** test 573 ****
305: c test 573 - test the effect of leading zero on an integer
306: c constant 00003.
307: c
308: c
309: if (iczero) 35730, 5730, 35730
310: 5730 continue
311: go to 45730
312: 35730 ivdele = ivdele + 1
313: write (i02,80003) ivtnum
314: if (iczero) 45730, 5741, 45730
315: 45730 if ( icon09 - 3 ) 25730, 15730, 25730
316: 15730 ivpass = ivpass + 1
317: write (i02,80001) ivtnum
318: go to 5741
319: 25730 ivfail = ivfail + 1
320: ivcomp = icon09
321: ivcorr = 3
322: write (i02,80004) ivtnum, ivcomp ,ivcorr
323: 5741 continue
324: ivtnum = 574
325: c
326: c **** test 574 ****
327: c test 574 - test of blanks imbedded in an integer constant
328: c which was / 3 2 7 6 7/ in the data initialization statement.
329: c
330: c
331: if (iczero) 35740, 5740, 35740
332: 5740 continue
333: go to 45740
334: 35740 ivdele = ivdele + 1
335: write (i02,80003) ivtnum
336: if (iczero) 45740, 5751, 45740
337: 45740 if ( icon10 - 32767 ) 25740, 15740, 25740
338: 15740 ivpass = ivpass + 1
339: write (i02,80001) ivtnum
340: go to 5751
341: 25740 ivfail = ivfail + 1
342: ivcomp = icon10
343: ivcorr = 32767
344: write (i02,80004) ivtnum, ivcomp ,ivcorr
345: 5751 continue
346: ivtnum = 575
347: c
348: c **** test 575 ****
349: c test 575 - test of a logical variable set to the logical
350: c constant .true.
351: c true path of a logical if statement is used in the test.
352: c
353: c
354: if (iczero) 35750, 5750, 35750
355: 5750 continue
356: ivon01 = 0
357: if ( lctn01 ) ivon01 = 1
358: go to 45750
359: 35750 ivdele = ivdele + 1
360: write (i02,80003) ivtnum
361: if (iczero) 45750, 5761, 45750
362: 45750 if ( ivon01 - 1 ) 25750, 15750, 25750
363: 15750 ivpass = ivpass + 1
364: write (i02,80001) ivtnum
365: go to 5761
366: 25750 ivfail = ivfail + 1
367: ivcomp = ivon01
368: ivcorr = 1
369: write (i02,80004) ivtnum, ivcomp ,ivcorr
370: 5761 continue
371: ivtnum = 576
372: c
373: c **** test 576 ****
374: c test 576 - test of a logical variable set to the logical
375: c constant .false. the false path of a logical if statement
376: c is also used in the test.
377: c
378: c
379: if (iczero) 35760, 5760, 35760
380: 5760 continue
381: ivon01 = 1
382: if ( lctn02 ) ivon01 = 0
383: go to 45760
384: 35760 ivdele = ivdele + 1
385: write (i02,80003) ivtnum
386: if (iczero) 45760, 5771, 45760
387: 45760 if ( ivon01 - 1 ) 25760, 15760, 25760
388: 15760 ivpass = ivpass + 1
389: write (i02,80001) ivtnum
390: go to 5771
391: 25760 ivfail = ivfail + 1
392: ivcomp = ivon01
393: ivcorr = 1
394: write (i02,80004) ivtnum, ivcomp ,ivcorr
395: 5771 continue
396: ivtnum = 577
397: c
398: c **** test 577 ****
399: c test 577 - real variable set to 0.
400: c
401: c
402: if (iczero) 35770, 5770, 35770
403: 5770 continue
404: go to 45770
405: 35770 ivdele = ivdele + 1
406: write (i02,80003) ivtnum
407: if (iczero) 45770, 5781, 45770
408: 45770 if ( rcon01 - 0. ) 25770, 15770, 25770
409: 15770 ivpass = ivpass + 1
410: write (i02,80001) ivtnum
411: go to 5781
412: 25770 ivfail = ivfail + 1
413: ivcomp = rcon01
414: ivcorr = 0
415: write (i02,80004) ivtnum, ivcomp ,ivcorr
416: 5781 continue
417: ivtnum = 578
418: c
419: c **** test 578 ****
420: c test 578 - real variable set to .0
421: c
422: c
423: if (iczero) 35780, 5780, 35780
424: 5780 continue
425: go to 45780
426: 35780 ivdele = ivdele + 1
427: write (i02,80003) ivtnum
428: if (iczero) 45780, 5791, 45780
429: 45780 if ( rcon02 - .0 ) 25780, 15780, 25780
430: 15780 ivpass = ivpass + 1
431: write (i02,80001) ivtnum
432: go to 5791
433: 25780 ivfail = ivfail + 1
434: ivcomp = rcon02
435: ivcorr = 0
436: write (i02,80004) ivtnum, ivcomp ,ivcorr
437: 5791 continue
438: ivtnum = 579
439: c
440: c **** test 579 ****
441: c test 579 - real variable set to 0.0
442: c
443: c
444: if (iczero) 35790, 5790, 35790
445: 5790 continue
446: go to 45790
447: 35790 ivdele = ivdele + 1
448: write (i02,80003) ivtnum
449: if (iczero) 45790, 5801, 45790
450: 45790 if ( rcon03 - 0.0 ) 25790, 15790, 25790
451: 15790 ivpass = ivpass + 1
452: write (i02,80001) ivtnum
453: go to 5801
454: 25790 ivfail = ivfail + 1
455: ivcomp = rcon03
456: ivcorr = 0
457: write (i02,80004) ivtnum, ivcomp ,ivcorr
458: 5801 continue
459: ivtnum = 580
460: c
461: c **** test 580 ****
462: c test 580 - real variable set to 32767.
463: c
464: c
465: if (iczero) 35800, 5800, 35800
466: 5800 continue
467: go to 45800
468: 35800 ivdele = ivdele + 1
469: write (i02,80003) ivtnum
470: if (iczero) 45800, 5811, 45800
471: 45800 if ( rcon04 - 32767. ) 25800, 15800, 25800
472: 15800 ivpass = ivpass + 1
473: write (i02,80001) ivtnum
474: go to 5811
475: 25800 ivfail = ivfail + 1
476: ivcomp = rcon04
477: ivcorr = 32767
478: write (i02,80004) ivtnum, ivcomp ,ivcorr
479: 5811 continue
480: ivtnum = 581
481: c
482: c **** test 581 ****
483: c test 581 - real variable set to -32766.
484: c
485: c
486: if (iczero) 35810, 5810, 35810
487: 5810 continue
488: go to 45810
489: 35810 ivdele = ivdele + 1
490: write (i02,80003) ivtnum
491: if (iczero) 45810, 5821, 45810
492: 45810 if ( rcon05 + 32766 ) 25810, 15810, 25810
493: 15810 ivpass = ivpass + 1
494: write (i02,80001) ivtnum
495: go to 5821
496: 25810 ivfail = ivfail + 1
497: ivcomp = rcon05
498: ivcorr = -32766
499: write (i02,80004) ivtnum, ivcomp ,ivcorr
500: 5821 continue
501: ivtnum = 582
502: c
503: c **** test 582 ****
504: c test 582 - real variable set to -000587. test of leading sign
505: c and leading zeros on a real constant.
506: c
507: c
508: if (iczero) 35820, 5820, 35820
509: 5820 continue
510: go to 45820
511: 35820 ivdele = ivdele + 1
512: write (i02,80003) ivtnum
513: if (iczero) 45820, 5831, 45820
514: 45820 if ( rcon06 + 587. ) 25820, 15820, 25820
515: 15820 ivpass = ivpass + 1
516: write (i02,80001) ivtnum
517: go to 5831
518: 25820 ivfail = ivfail + 1
519: ivcomp = rcon06
520: ivcorr = -587
521: write (i02,80004) ivtnum, ivcomp ,ivcorr
522: 5831 continue
523: ivtnum = 583
524: c
525: c **** test 583 ****
526: c test 583 - real variable set to 99.99
527: c
528: c
529: if (iczero) 35830, 5830, 35830
530: 5830 continue
531: go to 45830
532: 35830 ivdele = ivdele + 1
533: write (i02,80003) ivtnum
534: if (iczero) 45830, 5841, 45830
535: 45830 if ( rcon07 - 99.99 ) 25830, 15830, 25830
536: 15830 ivpass = ivpass + 1
537: write (i02,80001) ivtnum
538: go to 5841
539: 25830 ivfail = ivfail + 1
540: ivcomp = rcon07
541: ivcorr = 99
542: write (i02,80004) ivtnum, ivcomp ,ivcorr
543: 5841 continue
544: ivtnum = 584
545: c
546: c **** test 584 ****
547: c test 584 - real variable set to /-03. 2 7 6 6/ to test
548: c the effect of blanks imbedded in a real constant.
549: c
550: c
551: if (iczero) 35840, 5840, 35840
552: 5840 continue
553: go to 45840
554: 35840 ivdele = ivdele + 1
555: write (i02,80003) ivtnum
556: if (iczero) 45840, 5851, 45840
557: 45840 if ( rcon08 + 3.2766 ) 25840, 15840, 25840
558: 15840 ivpass = ivpass + 1
559: write (i02,80001) ivtnum
560: go to 5851
561: 25840 ivfail = ivfail + 1
562: ivcomp = rcon08
563: ivcorr = -3
564: write (i02,80004) ivtnum, ivcomp ,ivcorr
565: 5851 continue
566: ivtnum = 585
567: c
568: c **** test 585 ****
569: c test 585 - integer array element set to 3
570: c
571: c
572: if (iczero) 35850, 5850, 35850
573: 5850 continue
574: go to 45850
575: 35850 ivdele = ivdele + 1
576: write (i02,80003) ivtnum
577: if (iczero) 45850, 5861, 45850
578: 45850 if ( iadn11(1) - 3 ) 25850, 15850, 25850
579: 15850 ivpass = ivpass + 1
580: write (i02,80001) ivtnum
581: go to 5861
582: 25850 ivfail = ivfail + 1
583: ivcomp = iadn11(1)
584: ivcorr = 3
585: write (i02,80004) ivtnum, ivcomp ,ivcorr
586: 5861 continue
587: ivtnum = 586
588: c
589: c **** test 586 ****
590: c test 586 - integer array element set to 32767
591: c
592: c
593: if (iczero) 35860, 5860, 35860
594: 5860 continue
595: go to 45860
596: 35860 ivdele = ivdele + 1
597: write (i02,80003) ivtnum
598: if (iczero) 45860, 5871, 45860
599: 45860 if ( iadn11(2) - 32767 ) 25860, 15860, 25860
600: 15860 ivpass = ivpass + 1
601: write (i02,80001) ivtnum
602: go to 5871
603: 25860 ivfail = ivfail + 1
604: ivcomp = iadn11(2)
605: ivcorr = 32767
606: write (i02,80004) ivtnum, ivcomp ,ivcorr
607: 5871 continue
608: ivtnum = 587
609: c
610: c **** test 587 ****
611: c test 587 - integer array element set to -587
612: c
613: c
614: if (iczero) 35870, 5870, 35870
615: 5870 continue
616: go to 45870
617: 35870 ivdele = ivdele + 1
618: write (i02,80003) ivtnum
619: if (iczero) 45870, 5881, 45870
620: 45870 if ( iadn11(3) + 587 ) 25870, 15870, 25870
621: 15870 ivpass = ivpass + 1
622: write (i02,80001) ivtnum
623: go to 5881
624: 25870 ivfail = ivfail + 1
625: ivcomp = iadn11(3)
626: ivcorr = -587
627: write (i02,80004) ivtnum, ivcomp ,ivcorr
628: 5881 continue
629: ivtnum = 588
630: c
631: c **** test 588 ****
632: c test 588 - test of the repeat field /4*999/ in a data state.
633: c
634: c
635: if (iczero) 35880, 5880, 35880
636: 5880 continue
637: go to 45880
638: 35880 ivdele = ivdele + 1
639: write (i02,80003) ivtnum
640: if (iczero) 45880, 5891, 45880
641: 45880 if ( iadn12(3) - 9999 ) 25880, 15880, 25880
642: 15880 ivpass = ivpass + 1
643: write (i02,80001) ivtnum
644: go to 5891
645: 25880 ivfail = ivfail + 1
646: ivcomp = iadn12(3)
647: ivcorr = 9999
648: write (i02,80004) ivtnum, ivcomp ,ivcorr
649: 5891 continue
650: ivtnum = 589
651: c
652: c **** test 589 ****
653: c test 589 - test of setting the whole integer array elements
654: c in one data initialization statement. the first element
655: c is set to 0
656: c
657: c
658: if (iczero) 35890, 5890, 35890
659: 5890 continue
660: go to 45890
661: 35890 ivdele = ivdele + 1
662: write (i02,80003) ivtnum
663: if (iczero) 45890, 5901, 45890
664: 45890 if ( iadn13(1) - 0 ) 25890, 15890, 25890
665: 15890 ivpass = ivpass + 1
666: write (i02,80001) ivtnum
667: go to 5901
668: 25890 ivfail = ivfail + 1
669: ivcomp = iadn13(1)
670: ivcorr = 0
671: write (i02,80004) ivtnum, ivcomp ,ivcorr
672: 5901 continue
673: ivtnum = 590
674: c
675: c **** test 590 ****
676: c test 590 - see test 589. the second element was set to -32766
677: c
678: c
679: if (iczero) 35900, 5900, 35900
680: 5900 continue
681: go to 45900
682: 35900 ivdele = ivdele + 1
683: write (i02,80003) ivtnum
684: if (iczero) 45900, 5911, 45900
685: 45900 if ( iadn13(2) + 32766 ) 25900, 15900, 25900
686: 15900 ivpass = ivpass + 1
687: write (i02,80001) ivtnum
688: go to 5911
689: 25900 ivfail = ivfail + 1
690: ivcomp = iadn13(2)
691: ivcorr = -32766
692: write (i02,80004) ivtnum, ivcomp ,ivcorr
693: 5911 continue
694: ivtnum = 591
695: c
696: c **** test 591 ****
697: c test 591 - see test 589. the third element was set to -32766
698: c
699: c
700: if (iczero) 35910, 5910, 35910
701: 5910 continue
702: go to 45910
703: 35910 ivdele = ivdele + 1
704: write (i02,80003) ivtnum
705: if (iczero) 45910, 5921, 45910
706: 45910 if ( iadn13(3) + 32766 ) 25910, 15910, 25910
707: 15910 ivpass = ivpass + 1
708: write (i02,80001) ivtnum
709: go to 5921
710: 25910 ivfail = ivfail + 1
711: ivcomp = iadn13(3)
712: ivcorr = -32766
713: write (i02,80004) ivtnum, ivcomp ,ivcorr
714: 5921 continue
715: ivtnum = 592
716: c
717: c **** test 592 ****
718: c test 592 - see test 589. the fourth element was set to -587
719: c
720: c
721: if (iczero) 35920, 5920, 35920
722: 5920 continue
723: go to 45920
724: 35920 ivdele = ivdele + 1
725: write (i02,80003) ivtnum
726: if (iczero) 45920, 5931, 45920
727: 45920 if ( iadn13(4) + 587 ) 25920, 15920, 25920
728: 15920 ivpass = ivpass + 1
729: write (i02,80001) ivtnum
730: go to 5931
731: 25920 ivfail = ivfail + 1
732: ivcomp = iadn13(4)
733: ivcorr = -587
734: write (i02,80004) ivtnum, ivcomp ,ivcorr
735: 5931 continue
736: ivtnum = 593
737: c
738: c **** test 593 ****
739: c test 593 - test of setting the whole logical array in one
740: c data initialization statement. the first element is .true.
741: c the second and third elements are .false.
742: c the false path of a logical if statement is used testing 2.
743: c
744: c
745: if (iczero) 35930, 5930, 35930
746: 5930 continue
747: ivon01 = 1
748: if ( ladn11(2) ) ivon01 = 0
749: go to 45930
750: 35930 ivdele = ivdele + 1
751: write (i02,80003) ivtnum
752: if (iczero) 45930, 5941, 45930
753: 45930 if ( ivon01 - 1 ) 25930, 15930, 25930
754: 15930 ivpass = ivpass + 1
755: write (i02,80001) ivtnum
756: go to 5941
757: 25930 ivfail = ivfail + 1
758: ivcomp = ivon01
759: ivcorr = 1
760: write (i02,80004) ivtnum, ivcomp ,ivcorr
761: 5941 continue
762: ivtnum = 594
763: c
764: c **** test 594 ****
765: c test 594 - see test 593. the fourth element is tested
766: c with the true path of the logical if statement.
767: c
768: c
769: if (iczero) 35940, 5940, 35940
770: 5940 continue
771: ivon01 = 0
772: if ( ladn11(4) ) ivon01 = 1
773: go to 45940
774: 35940 ivdele = ivdele + 1
775: write (i02,80003) ivtnum
776: if (iczero) 45940, 5951, 45940
777: 45940 if ( ivon01 - 1 ) 25940, 15940, 25940
778: 15940 ivpass = ivpass + 1
779: write (i02,80001) ivtnum
780: go to 5951
781: 25940 ivfail = ivfail + 1
782: ivcomp = ivon01
783: ivcorr = 1
784: write (i02,80004) ivtnum, ivcomp ,ivcorr
785: 5951 continue
786: ivtnum = 595
787: c
788: c **** test 595 ****
789: c test 595 - a whole real array is set in one data initialization
790: c statement. the second element is -32.766
791: c
792: c
793: if (iczero) 35950, 5950, 35950
794: 5950 continue
795: go to 45950
796: 35950 ivdele = ivdele + 1
797: write (i02,80003) ivtnum
798: if (iczero) 45950, 5961, 45950
799: 45950 if ( radn11(2) + 32.766 ) 25950, 15950, 25950
800: 15950 ivpass = ivpass + 1
801: write (i02,80001) ivtnum
802: go to 5961
803: 25950 ivfail = ivfail + 1
804: ivcomp = radn11(2)
805: ivcorr = -32
806: write (i02,80004) ivtnum, ivcomp ,ivcorr
807: 5961 continue
808: ivtnum = 596
809: c
810: c **** test 596 ****
811: c test 596 - see test 595. the fourth element is set to 587
812: c by a repeat field.
813: c
814: c
815: if (iczero) 35960, 5960, 35960
816: 5960 continue
817: go to 45960
818: 35960 ivdele = ivdele + 1
819: write (i02,80003) ivtnum
820: if (iczero) 45960, 5971, 45960
821: 45960 if ( radn11(4) - 587 ) 25960, 15960, 25960
822: 15960 ivpass = ivpass + 1
823: write (i02,80001) ivtnum
824: go to 5971
825: 25960 ivfail = ivfail + 1
826: ivcomp = radn11(4)
827: ivcorr = 587
828: write (i02,80004) ivtnum, ivcomp ,ivcorr
829: 5971 continue
830: ivtnum = 597
831: c
832: c **** test 597 ****
833: c test 597 - test of mixed array element types in a single data
834: c initialization statement. the type logical statement contains
835: c the array declarations. the false path of a logical
836: c if statement tests the logical results.
837: c
838: c
839: if (iczero) 35970, 5970, 35970
840: 5970 continue
841: ivon01 = 1
842: if ( latn11(2) ) ivon01 = 0
843: go to 45970
844: 35970 ivdele = ivdele + 1
845: write (i02,80003) ivtnum
846: if (iczero) 45970, 5981, 45970
847: 45970 if ( ivon01 - 1 ) 25970, 15970, 25970
848: 15970 ivpass = ivpass + 1
849: write (i02,80001) ivtnum
850: go to 5981
851: 25970 ivfail = ivfail + 1
852: ivcomp = ivon01
853: ivcorr = 1
854: write (i02,80004) ivtnum, ivcomp ,ivcorr
855: 5981 continue
856: ivtnum = 598
857: c
858: c **** test 598 ****
859: c test 598 - type of the data was set explicitly real in the
860: c declarative for the array. data should be set to 32767.
861: c
862: c
863: if (iczero) 35980, 5980, 35980
864: 5980 continue
865: go to 45980
866: 35980 ivdele = ivdele + 1
867: write (i02,80003) ivtnum
868: if (iczero) 45980, 5991, 45980
869: 45980 if ( iatn11(2) - 32767. ) 25980, 15980, 25980
870: 15980 ivpass = ivpass + 1
871: write (i02,80001) ivtnum
872: go to 5991
873: 25980 ivfail = ivfail + 1
874: ivcomp = iatn11(2)
875: ivcorr = 32767
876: write (i02,80004) ivtnum, ivcomp ,ivcorr
877: 5991 continue
878: ivtnum = 599
879: c
880: c **** test 599 ****
881: c test 599 - type of the data was set explicitly integer in the
882: c declarative for the array. data should be set to -32766
883: c
884: c
885: if (iczero) 35990, 5990, 35990
886: 5990 continue
887: go to 45990
888: 35990 ivdele = ivdele + 1
889: write (i02,80003) ivtnum
890: if (iczero) 45990, 6001, 45990
891: 45990 if ( ratn11(2) + 32766 ) 25990, 15990, 25990
892: 15990 ivpass = ivpass + 1
893: write (i02,80001) ivtnum
894: go to 6001
895: 25990 ivfail = ivfail + 1
896: ivcomp = ratn11(2)
897: ivcorr = -32766
898: write (i02,80004) ivtnum, ivcomp ,ivcorr
899: 6001 continue
900: ivtnum = 600
901: c
902: c **** test 600 ****
903: c test 600 - test of real decimal constants using e-notation.
904: c see section 4.4.2. the value of the element should
905: c be set to 32767.
906: c
907: c
908: if (iczero) 36000, 6000, 36000
909: 6000 continue
910: go to 46000
911: 36000 ivdele = ivdele + 1
912: write (i02,80003) ivtnum
913: if (iczero) 46000, 6011, 46000
914: 46000 if ( radn13(1) - 32767. ) 26000, 16000, 26000
915: 16000 ivpass = ivpass + 1
916: write (i02,80001) ivtnum
917: go to 6011
918: 26000 ivfail = ivfail + 1
919: ivcomp = radn13(1)
920: ivcorr = 32767
921: write (i02,80004) ivtnum, ivcomp ,ivcorr
922: 6011 continue
923: ivtnum = 601
924: c
925: c **** test 601 ****
926: c test 601 - like test 600. real decimal constant value -.32766
927: c
928: c
929: if (iczero) 36010, 6010, 36010
930: 6010 continue
931: go to 46010
932: 36010 ivdele = ivdele + 1
933: write (i02,80003) ivtnum
934: if (iczero) 46010, 6021, 46010
935: 46010 if ( radn13(2) + .32766 ) 26010, 16010, 26010
936: 16010 ivpass = ivpass + 1
937: write (i02,80001) ivtnum
938: go to 6021
939: 26010 ivfail = ivfail + 1
940: ivcomp = radn13(2)
941: ivcorr = 0
942: write (i02,80004) ivtnum, ivcomp ,ivcorr
943: 6021 continue
944: ivtnum = 602
945: c
946: c **** test 602 ****
947: c test 602 - like test 600. real decimal constant value 587.
948: c
949: c
950: if (iczero) 36020, 6020, 36020
951: 6020 continue
952: go to 46020
953: 36020 ivdele = ivdele + 1
954: write (i02,80003) ivtnum
955: if (iczero) 46020, 6031, 46020
956: 46020 if ( radn13(3) - 587 ) 26020, 16020, 26020
957: 16020 ivpass = ivpass + 1
958: write (i02,80001) ivtnum
959: go to 6031
960: 26020 ivfail = ivfail + 1
961: ivcomp = radn13(3)
962: ivcorr = 587
963: write (i02,80004) ivtnum, ivcomp ,ivcorr
964: 6031 continue
965: ivtnum = 603
966: c
967: c **** test 603 ****
968: c test 603 - like test 600. real decimal constant value 90.
969: c
970: c
971: if (iczero) 36030, 6030, 36030
972: 6030 continue
973: go to 46030
974: 36030 ivdele = ivdele + 1
975: write (i02,80003) ivtnum
976: if (iczero) 46030, 6041, 46030
977: 46030 if ( radn13(4) - 90. ) 26030, 16030, 26030
978: 16030 ivpass = ivpass + 1
979: write (i02,80001) ivtnum
980: go to 6041
981: 26030 ivfail = ivfail + 1
982: ivcomp = radn13(4)
983: ivcorr = 90
984: write (i02,80004) ivtnum, ivcomp ,ivcorr
985: 6041 continue
986: c
987: c write page footings and run summaries
988: 99999 continue
989: write (i02,90002)
990: write (i02,90006)
991: write (i02,90002)
992: write (i02,90002)
993: write (i02,90007)
994: write (i02,90002)
995: write (i02,90008) ivfail
996: write (i02,90009) ivpass
997: write (i02,90010) ivdele
998: c
999: c
1000: c terminate routine execution
1001: stop
1002: c
1003: c format statements for page headers
1004: 90000 format (1h1)
1005: 90002 format (1h )
1006: 90001 format (1h ,10x,34hfortran compiler validation system)
1007: 90003 format (1h ,21x,11hversion 1.0)
1008: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
1009: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
1010: 90006 format (1h ,5x,46h----------------------------------------------)
1011: 90011 format (1h ,18x,17hsubset level test)
1012: c
1013: c format statements for run summaries
1014: 90008 format (1h ,15x,i5,19h errors encountered)
1015: 90009 format (1h ,15x,i5,13h tests passed)
1016: 90010 format (1h ,15x,i5,14h tests deleted)
1017: c
1018: c format statements for test results
1019: 80001 format (1h ,4x,i5,7x,4hpass)
1020: 80002 format (1h ,4x,i5,7x,4hfail)
1021: 80003 format (1h ,4x,i5,7x,7hdeleted)
1022: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
1023: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
1024: c
1025: 90007 format (1h ,20x,20hend of program fm021)
1026: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.