|
|
1.1 root 1: c
2: c comment section.
3: c
4: c fm018
5: c
6: c this routine continues tests of the fortran
7: c logical if statement in all of the various forms. the
8: c following logical operands are used for this routine - logical
9: c constants, logical variables, logical array elements, and
10: c arithmetic expressions with various relational operators. both
11: c the true and false branches are tested in the series of tests.
12: c
13: c references
14: c american national standard programming language fortran,
15: c x3.9-1978
16: c
17: c section 4.7.1, logical constant
18: c section 6, expressions
19: c section 6.1, arithmetic expressions
20: c section 6.3, relational expressions
21: c section 6.4, logical expressions
22: c section 6.6, evaluation of expressions
23: c section 10, assignment statements
24: c section 10.2, logical assignment statement
25: c section 11.5, logical if statement
26: c
27: logical lctnt1, lctnt2, latn1a(2)
28: dimension iadn11(2)
29: c
30: c **********************************************************
31: c
32: c a compiler validation system for the fortran language
33: c based on specifications as defined in american national standard
34: c programming language fortran x3.9-1978, has been developed by the
35: c federal cobol compiler testing service. the fortran compiler
36: c validation system (fcvs) consists of audit routines, their related
37: c data, and an executive system. each audit routine is a fortran
38: c program, subprogram or function which includes tests of specific
39: c language elements and supporting procedures indicating the result
40: c of executing these tests.
41: c
42: c this particular program/subprogram/function contains features
43: c found only in the subset as defined in x3.9-1978.
44: c
45: c suggestions and comments should be forwarded to -
46: c
47: c department of the navy
48: c federal cobol compiler testing service
49: c washington, d.c. 20376
50: c
51: c **********************************************************
52: c
53: c
54: c
55: c initialization section
56: c
57: c initialize constants
58: c **************
59: c i01 contains the logical unit number for the card reader.
60: i01 = 5
61: c i02 contains the logical unit number for the printer.
62: i02 = 6
63: c system environment section
64: c
65: cx010 this card is replaced by contents of fexec x-010 control card.
66: c the cx010 card is for overriding the program default i01 = 5
67: c (unit number for card reader).
68: cx011 this card is replaced by contents of fexec x-011 control card.
69: c the cx011 card is for systems which require additional
70: c fortran statements for files associated with cx010 above.
71: c
72: cx020 this card is replaced by contents of fexec x-020 control card.
73: c the cx020 card is for overriding the program default i02 = 6
74: c (unit number for printer).
75: cx021 this card is replaced by contents of fexec x-021 control card.
76: c the cx021 card is for systems which require additional
77: c fortran statements for files associated with cx020 above.
78: c
79: ivpass=0
80: ivfail=0
81: ivdele=0
82: iczero=0
83: c
84: c write page headers
85: write (i02,90000)
86: write (i02,90001)
87: write (i02,90002)
88: write (i02, 90002)
89: write (i02,90003)
90: write (i02,90002)
91: write (i02,90004)
92: write (i02,90002)
93: write (i02,90011)
94: write (i02,90002)
95: write (i02,90002)
96: write (i02,90005)
97: write (i02,90006)
98: write (i02,90002)
99: ivtnum = 500
100: c
101: c **** test 500 ****
102: c test 500 - like test 197. true .or. true true path
103: c test of the fortran inclusive or (le) .or. (lt)
104: c
105: c
106: if (iczero) 35000, 5000, 35000
107: 5000 continue
108: ivon01 = 0
109: lctnt1 = .true.
110: lctnt2 = .true.
111: if ( lctnt1 .or. lctnt2 ) ivon01 = 1
112: go to 45000
113: 35000 ivdele = ivdele + 1
114: write (i02,80003) ivtnum
115: if (iczero) 45000, 5011, 45000
116: 45000 if ( ivon01 - 1 ) 25000, 15000, 25000
117: 15000 ivpass = ivpass + 1
118: write (i02,80001) ivtnum
119: go to 5011
120: 25000 ivfail = ivfail + 1
121: ivcomp = ivon01
122: ivcorr = 1
123: write (i02,80004) ivtnum, ivcomp ,ivcorr
124: 5011 continue
125: ivtnum = 501
126: c
127: c **** test 501 ****
128: c test 501 - test of parentheses around a logical expression
129: c ( (le) ) .or. (lt)
130: c uses logical variables set in logical assignment statements
131: c ( false ) .or. false false path
132: c
133: c
134: if (iczero) 35010, 5010, 35010
135: 5010 continue
136: ivon01 = 1
137: lctnt1 = .false.
138: lctnt2 = .false.
139: if ( (lctnt1) .or. lctnt2 ) ivon01 = 0
140: go to 45010
141: 35010 ivdele = ivdele + 1
142: write (i02,80003) ivtnum
143: if (iczero) 45010, 5021, 45010
144: 45010 if ( ivon01 - 1 ) 25010, 15010, 25010
145: 15010 ivpass = ivpass + 1
146: write (i02,80001) ivtnum
147: go to 5021
148: 25010 ivfail = ivfail + 1
149: ivcomp = ivon01
150: ivcorr = 1
151: write (i02,80004) ivtnum, ivcomp ,ivcorr
152: 5021 continue
153: ivtnum = 502
154: c
155: c **** test 502 ****
156: c test 502 - like test 501 except that it it is of the form
157: c (le) .or. ( (lt) ) true .or. (true)
158: c true path
159: c
160: c
161: if (iczero) 35020, 5020, 35020
162: 5020 continue
163: ivon01 = 0
164: lctnt1 = .true.
165: lctnt2 = .true.
166: if ( lctnt1 .or. ( lctnt2 ) ) ivon01 = 1
167: go to 45020
168: 35020 ivdele = ivdele + 1
169: write (i02,80003) ivtnum
170: if (iczero) 45020, 5031, 45020
171: 45020 if ( ivon01 - 1 ) 25020, 15020, 25020
172: 15020 ivpass = ivpass + 1
173: write (i02,80001) ivtnum
174: go to 5031
175: 25020 ivfail = ivfail + 1
176: ivcomp = ivon01
177: ivcorr = 1
178: write (i02,80004) ivtnum, ivcomp ,ivcorr
179: 5031 continue
180: ivtnum = 503
181: c
182: c **** test 503 ****
183: c test 503 - test of parentheses in logical expressions
184: c ( (le) ) .or. ( (lt) )
185: c (false) .or. (true) true path
186: c
187: c
188: if (iczero) 35030, 5030, 35030
189: 5030 continue
190: ivon01 = 0
191: lctnt1 = .false.
192: lctnt2 = .true.
193: if ( (lctnt1) .or. (lctnt2) ) ivon01 = 1
194: go to 45030
195: 35030 ivdele = ivdele + 1
196: write (i02,80003) ivtnum
197: if (iczero) 45030, 5041, 45030
198: 45030 if ( ivon01 - 1 ) 25030, 15030, 25030
199: 15030 ivpass = ivpass + 1
200: write (i02,80001) ivtnum
201: go to 5041
202: 25030 ivfail = ivfail + 1
203: ivcomp = ivon01
204: ivcorr = 1
205: write (i02,80004) ivtnum, ivcomp ,ivcorr
206: 5041 continue
207: ivtnum = 504
208: c
209: c **** test 504 ****
210: c test 504 - like test 503 only more parentheses true path
211: c
212: c
213: if (iczero) 35040, 5040, 35040
214: 5040 continue
215: ivon01 = 0
216: lctnt1 = .true.
217: lctnt2 = .false.
218: if ( ( (lctnt1) .or. (lctnt2) ) ) ivon01 = 1
219: go to 45040
220: 35040 ivdele = ivdele + 1
221: write (i02,80003) ivtnum
222: if (iczero) 45040, 5051, 45040
223: 45040 if ( ivon01 - 1 ) 25040, 15040, 25040
224: 15040 ivpass = ivpass + 1
225: write (i02,80001) ivtnum
226: go to 5051
227: 25040 ivfail = ivfail + 1
228: ivcomp = ivon01
229: ivcorr = 1
230: write (i02,80004) ivtnum, ivcomp ,ivcorr
231: 5051 continue
232: ivtnum = 505
233: c
234: c **** test 505 ****
235: c test 505 - test of parentheses with .and. false path
236: c
237: c
238: if (iczero) 35050, 5050, 35050
239: 5050 continue
240: ivon01 = 1
241: lctnt1 = .false.
242: lctnt2 = .false.
243: if ( (lctnt1) .and. lctnt2 ) ivon01 = 0
244: go to 45050
245: 35050 ivdele = ivdele + 1
246: write (i02,80003) ivtnum
247: if (iczero) 45050, 5061, 45050
248: 45050 if ( ivon01 - 1 ) 25050, 15050, 25050
249: 15050 ivpass = ivpass + 1
250: write (i02,80001) ivtnum
251: go to 5061
252: 25050 ivfail = ivfail + 1
253: ivcomp = ivon01
254: ivcorr = 1
255: write (i02,80004) ivtnum, ivcomp ,ivcorr
256: 5061 continue
257: ivtnum = 506
258: c
259: c **** test 506 ****
260: c test 506 - like test 505 false path
261: c
262: c
263: if (iczero) 35060, 5060, 35060
264: 5060 continue
265: ivon01 = 1
266: lctnt1 = .false.
267: lctnt2 = .true.
268: if ( lctnt1 .and. (lctnt2) ) ivon01 = 0
269: go to 45060
270: 35060 ivdele = ivdele + 1
271: write (i02,80003) ivtnum
272: if (iczero) 45060, 5071, 45060
273: 45060 if ( ivon01 - 1 ) 25060, 15060, 25060
274: 15060 ivpass = ivpass + 1
275: write (i02,80001) ivtnum
276: go to 5071
277: 25060 ivfail = ivfail + 1
278: ivcomp = ivon01
279: ivcorr = 1
280: write (i02,80004) ivtnum, ivcomp ,ivcorr
281: 5071 continue
282: ivtnum = 507
283: c
284: c **** test 507 ****
285: c test 507 - more parentheses with logical .and. false path
286: c
287: c
288: if (iczero) 35070, 5070, 35070
289: 5070 continue
290: ivon01 = 1
291: lctnt1 = .true.
292: lctnt2 = .false.
293: if ( (lctnt1) .and. (lctnt2) ) ivon01 = 0
294: go to 45070
295: 35070 ivdele = ivdele + 1
296: write (i02,80003) ivtnum
297: if (iczero) 45070, 5081, 45070
298: 45070 if ( ivon01 - 1 ) 25070, 15070, 25070
299: 15070 ivpass = ivpass + 1
300: write (i02,80001) ivtnum
301: go to 5081
302: 25070 ivfail = ivfail + 1
303: ivcomp = ivon01
304: ivcorr = 1
305: write (i02,80004) ivtnum, ivcomp ,ivcorr
306: 5081 continue
307: ivtnum = 508
308: c
309: c **** test 508 ****
310: c test 508 - test of logical .not. with parentheses around a logic
311: c primary. for this test a logical array element is used as
312: c the logical primary. .not. (false) true path.
313: c
314: c
315: if (iczero) 35080, 5080, 35080
316: 5080 continue
317: ivon01 = 0
318: latn1a(1) = .false.
319: if ( .not. (latn1a(1)) ) ivon01 = 1
320: go to 45080
321: 35080 ivdele = ivdele + 1
322: write (i02,80003) ivtnum
323: if (iczero) 45080, 5091, 45080
324: 45080 if ( ivon01 - 1 ) 25080, 15080, 25080
325: 15080 ivpass = ivpass + 1
326: write (i02,80001) ivtnum
327: go to 5091
328: 25080 ivfail = ivfail + 1
329: ivcomp = ivon01
330: ivcorr = 1
331: write (i02,80004) ivtnum, ivcomp ,ivcorr
332: 5091 continue
333: ivtnum = 509
334: c
335: c **** test 509 ****
336: c test 509 - like test 508 except that the whole expression
337: c is in parentheses. false path
338: c
339: c
340: if (iczero) 35090, 5090, 35090
341: 5090 continue
342: ivon01 = 1
343: latn1a(2) = .true.
344: if ( ( .not. (latn1a(2)) ) ) ivon01 = 0
345: go to 45090
346: 35090 ivdele = ivdele + 1
347: write (i02,80003) ivtnum
348: if (iczero) 45090, 5101, 45090
349: 45090 if ( ivon01 - 1 ) 25090, 15090, 25090
350: 15090 ivpass = ivpass + 1
351: write (i02,80001) ivtnum
352: go to 5101
353: 25090 ivfail = ivfail + 1
354: ivcomp = ivon01
355: ivcorr = 1
356: write (i02,80004) ivtnum, ivcomp ,ivcorr
357: 5101 continue
358: ivtnum = 510
359: c
360: c **** test 510 ****
361: c test 510 - integer constant exponientation
362: c relational expression using .eq. true path
363: c
364: c
365: if (iczero) 35100, 5100, 35100
366: 5100 continue
367: ivon01 = 0
368: if ( 3 ** 3 .eq. 27 ) ivon01 = 1
369: go to 45100
370: 35100 ivdele = ivdele + 1
371: write (i02,80003) ivtnum
372: if (iczero) 45100, 5111, 45100
373: 45100 if ( ivon01 - 1 ) 25100, 15100, 25100
374: 15100 ivpass = ivpass + 1
375: write (i02,80001) ivtnum
376: go to 5111
377: 25100 ivfail = ivfail + 1
378: ivcomp = ivon01
379: ivcorr = 1
380: write (i02,80004) ivtnum, ivcomp ,ivcorr
381: 5111 continue
382: ivtnum = 511
383: c
384: c **** test 511 ****
385: c test 511 - exponientiation using an integer variable
386: c relational expression using .ne. false path
387: c
388: c
389: if (iczero) 35110, 5110, 35110
390: 5110 continue
391: ivon01 = 1
392: ivon02 = 3
393: if ( ivon02 ** 3 .ne. 27 ) ivon01 = 0
394: go to 45110
395: 35110 ivdele = ivdele + 1
396: write (i02,80003) ivtnum
397: if (iczero) 45110, 5121, 45110
398: 45110 if ( ivon01 - 1 ) 25110, 15110, 25110
399: 15110 ivpass = ivpass + 1
400: write (i02,80001) ivtnum
401: go to 5121
402: 25110 ivfail = ivfail + 1
403: ivcomp = ivon01
404: ivcorr = 1
405: write (i02,80004) ivtnum, ivcomp ,ivcorr
406: 5121 continue
407: ivtnum = 512
408: c
409: c **** test 512 ****
410: c test 512 - like test 511 uses .le. true path
411: c
412: c
413: if (iczero) 35120, 5120, 35120
414: 5120 continue
415: ivon01 = 0
416: ivon02 = 3
417: if ( 3 ** ivon02 .le. 27 ) ivon01 = 1
418: go to 45120
419: 35120 ivdele = ivdele + 1
420: write (i02,80003) ivtnum
421: if (iczero) 45120, 5131, 45120
422: 45120 if ( ivon01 - 1 ) 25120, 15120, 25120
423: 15120 ivpass = ivpass + 1
424: write (i02,80001) ivtnum
425: go to 5131
426: 25120 ivfail = ivfail + 1
427: ivcomp = ivon01
428: ivcorr = 1
429: write (i02,80004) ivtnum, ivcomp ,ivcorr
430: 5131 continue
431: ivtnum = 513
432: c
433: c **** test 513 ****
434: c test 513 - like test 511 but uses all integer variables
435: c relational expression uses .lt. false path
436: c
437: c
438: if (iczero) 35130, 5130, 35130
439: 5130 continue
440: ivon01 = 1
441: ivon02 = 3
442: ivon03 = 27
443: if ( ivon02 ** ivon02 .lt. ivon03 ) ivon01 = 0
444: go to 45130
445: 35130 ivdele = ivdele + 1
446: write (i02,80003) ivtnum
447: if (iczero) 45130, 5141, 45130
448: 45130 if ( ivon01 - 1 ) 25130, 15130, 25130
449: 15130 ivpass = ivpass + 1
450: write (i02,80001) ivtnum
451: go to 5141
452: 25130 ivfail = ivfail + 1
453: ivcomp = ivon01
454: ivcorr = 1
455: write (i02,80004) ivtnum, ivcomp ,ivcorr
456: 5141 continue
457: ivtnum = 514
458: c
459: c **** test 514 ****
460: c test 514 - like test 511 but uses integer array elements
461: c relational expression uses .ge. true path
462: c
463: c
464: if (iczero) 35140, 5140, 35140
465: 5140 continue
466: ivon01 = 0
467: ivon02 = 3
468: iadn11(1) = 3
469: iadn11(2) = 27
470: if ( iadn11(1) ** ivon02 .ge. iadn11(2) ) ivon01 = 1
471: go to 45140
472: 35140 ivdele = ivdele + 1
473: write (i02,80003) ivtnum
474: if (iczero) 45140, 5151, 45140
475: 45140 if ( ivon01 - 1 ) 25140, 15140, 25140
476: 15140 ivpass = ivpass + 1
477: write (i02,80001) ivtnum
478: go to 5151
479: 25140 ivfail = ivfail + 1
480: ivcomp = ivon01
481: ivcorr = 1
482: write (i02,80004) ivtnum, ivcomp ,ivcorr
483: 5151 continue
484: ivtnum = 515
485: c
486: c **** test 515 ****
487: c test 515 - like test 514 but uses all integer array elements
488: c relational expression uses .gt. false path
489: c
490: c
491: if (iczero) 35150, 5150, 35150
492: 5150 continue
493: ivon01 = 1
494: iadn11(1) = 3
495: iadn11(2) = 27
496: if ( iadn11(1) ** iadn11(1) .gt. iadn11(2) ) ivon01 = 0
497: go to 45150
498: 35150 ivdele = ivdele + 1
499: write (i02,80003) ivtnum
500: if (iczero) 45150, 5161, 45150
501: 45150 if ( ivon01 - 1 ) 25150, 15150, 25150
502: 15150 ivpass = ivpass + 1
503: write (i02,80001) ivtnum
504: go to 5161
505: 25150 ivfail = ivfail + 1
506: ivcomp = ivon01
507: ivcorr = 1
508: write (i02,80004) ivtnum, ivcomp ,ivcorr
509: 5161 continue
510: ivtnum = 516
511: c
512: c **** test 516 ****
513: c test 516 - test of integer multiplication using integer
514: c constants. relational expression uses .lt. true path
515: c
516: c
517: if (iczero) 35160, 5160, 35160
518: 5160 continue
519: ivon01 = 0
520: ivon02 = 587
521: if ( 3 * 3 .lt. ivon02 ) ivon01 = 1
522: go to 45160
523: 35160 ivdele = ivdele + 1
524: write (i02,80003) ivtnum
525: if (iczero) 45160, 5171, 45160
526: 45160 if ( ivon01 - 1 ) 25160, 15160, 25160
527: 15160 ivpass = ivpass + 1
528: write (i02,80001) ivtnum
529: go to 5171
530: 25160 ivfail = ivfail + 1
531: ivcomp = ivon01
532: ivcorr = 1
533: write (i02,80004) ivtnum, ivcomp ,ivcorr
534: 5171 continue
535: ivtnum = 517
536: c
537: c **** test 517 ****
538: c test 517 - integer multiplication with integer constants,
539: c variables, and array elements. relational expression uses
540: c .gt. false path
541: c
542: c
543: if (iczero) 35170, 5170, 35170
544: 5170 continue
545: ivon01 = 1
546: ivon02 = 32767
547: iadn11(1) = 3
548: if ( iadn11(1) * 587 .gt. ivon02 ) ivon01 = 0
549: go to 45170
550: 35170 ivdele = ivdele + 1
551: write (i02,80003) ivtnum
552: if (iczero) 45170, 5181, 45170
553: 45170 if ( ivon01 - 1 ) 25170, 15170, 25170
554: 15170 ivpass = ivpass + 1
555: write (i02,80001) ivtnum
556: go to 5181
557: 25170 ivfail = ivfail + 1
558: ivcomp = ivon01
559: ivcorr = 1
560: write (i02,80004) ivtnum, ivcomp ,ivcorr
561: 5181 continue
562: ivtnum = 518
563: c
564: c **** test 518 ****
565: c test 518 - integer multiplication and exponientation
566: c relational expression uses .eq. true path
567: c
568: c
569: if (iczero) 35180, 5180, 35180
570: 5180 continue
571: ivon01 = 0
572: ivon02 = 3
573: ivon03 = 27
574: iadn11(2) = 3
575: if ( iadn11(2) ** 2 * ivon02 .eq. ivon03 ) ivon01 = 1
576: go to 45180
577: 35180 ivdele = ivdele + 1
578: write (i02,80003) ivtnum
579: if (iczero) 45180, 5191, 45180
580: 45180 if ( ivon01 - 1 ) 25180, 15180, 25180
581: 15180 ivpass = ivpass + 1
582: write (i02,80001) ivtnum
583: go to 5191
584: 25180 ivfail = ivfail + 1
585: ivcomp = ivon01
586: ivcorr = 1
587: write (i02,80004) ivtnum, ivcomp ,ivcorr
588: 5191 continue
589: ivtnum = 519
590: c
591: c **** test 519 ****
592: c test 519 - integer division. relational expression .ne.
593: c false path
594: c
595: c
596: if (iczero) 35190, 5190, 35190
597: 5190 continue
598: ivon01 = 1
599: ivon02 = 27
600: iadn11(1) = 3
601: if ( ivon02 / 9 .ne. iadn11(1) ) ivon01 = 0
602: go to 45190
603: 35190 ivdele = ivdele + 1
604: write (i02,80003) ivtnum
605: if (iczero) 45190, 5201, 45190
606: 45190 if ( ivon01 - 1 ) 25190, 15190, 25190
607: 15190 ivpass = ivpass + 1
608: write (i02,80001) ivtnum
609: go to 5201
610: 25190 ivfail = ivfail + 1
611: ivcomp = ivon01
612: ivcorr = 1
613: write (i02,80004) ivtnum, ivcomp ,ivcorr
614: 5201 continue
615: ivtnum = 520
616: c
617: c **** test 520 ****
618: c test 520 - integer variable division. relational expression
619: c uses .ge. true path
620: c
621: c
622: if (iczero) 35200, 5200, 35200
623: 5200 continue
624: ivon01 = 0
625: ivon02 = 32767
626: ivon03 = 3
627: ivon04 = 9999
628: ivon05 = 587
629: if ( ivon02 / ivon03 .ge. ivon04 / ivon05 ) ivon01 = 1
630: go to 45200
631: 35200 ivdele = ivdele + 1
632: write (i02,80003) ivtnum
633: if (iczero) 45200, 5211, 45200
634: 45200 if ( ivon01 - 1 ) 25200, 15200, 25200
635: 15200 ivpass = ivpass + 1
636: write (i02,80001) ivtnum
637: go to 5211
638: 25200 ivfail = ivfail + 1
639: ivcomp = ivon01
640: ivcorr = 1
641: write (i02,80004) ivtnum, ivcomp ,ivcorr
642: 5211 continue
643: ivtnum = 521
644: c
645: c **** test 521 ****
646: c test 521 - integer division and exponientation
647: c relational expression uses .lt. false path
648: c
649: c
650: if (iczero) 35210, 5210, 35210
651: 5210 continue
652: ivon01 = 1
653: ivon02 = 587
654: ivon03 = 3
655: iadn11(2) = 3
656: if ( ivon02 / iadn11(2) ** 3 .lt. 3 ** ivon03 / ivon02 ) ivon01 =0
657: if ( ivon02 / iadn11(2) ** 3 .lt. 3 ** ivon03 / ivon02 ) ivon01=0
658: go to 45210
659: 35210 ivdele = ivdele + 1
660: write (i02,80003) ivtnum
661: if (iczero) 45210, 5221, 45210
662: 45210 if ( ivon01 - 1 ) 25210, 15210, 25210
663: 15210 ivpass = ivpass + 1
664: write (i02,80001) ivtnum
665: go to 5221
666: 25210 ivfail = ivfail + 1
667: ivcomp = ivon01
668: ivcorr = 1
669: write (i02,80004) ivtnum, ivcomp ,ivcorr
670: 5221 continue
671: ivtnum = 522
672: c
673: c **** test 522 ****
674: c test 522 - tests 522 thru 535 are tests of signed terms
675: c +(t) also -(t)
676: c relational expression uses .gt. true path
677: c
678: c
679: if (iczero) 35220, 5220, 35220
680: 5220 continue
681: ivon01 = 0
682: if ( 3 .gt. -3 ) ivon01 = 1
683: go to 45220
684: 35220 ivdele = ivdele + 1
685: write (i02,80003) ivtnum
686: if (iczero) 45220, 5231, 45220
687: 45220 if ( ivon01 - 1 ) 25220, 15220, 25220
688: 15220 ivpass = ivpass + 1
689: write (i02,80001) ivtnum
690: go to 5231
691: 25220 ivfail = ivfail + 1
692: ivcomp = ivon01
693: ivcorr = 1
694: write (i02,80004) ivtnum, ivcomp ,ivcorr
695: 5231 continue
696: ivtnum = 523
697: c
698: c **** test 523 ****
699: c test 523 - test of signed zero .lt. false path
700: c
701: c
702: if (iczero) 35230, 5230, 35230
703: 5230 continue
704: ivon01 = 1
705: if ( 0 .lt. -0 ) ivon01 = 0
706: go to 45230
707: 35230 ivdele = ivdele + 1
708: write (i02,80003) ivtnum
709: if (iczero) 45230, 5241, 45230
710: 45230 if ( ivon01 - 1 ) 25230, 15230, 25230
711: 15230 ivpass = ivpass + 1
712: write (i02,80001) ivtnum
713: go to 5241
714: 25230 ivfail = ivfail + 1
715: ivcomp = ivon01
716: ivcorr = 1
717: write (i02,80004) ivtnum, ivcomp ,ivcorr
718: 5241 continue
719: ivtnum = 524
720: c
721: c **** test 524 ****
722: c test 524 - test of signed zero .le. true path
723: c
724: c
725: if (iczero) 35240, 5240, 35240
726: 5240 continue
727: ivon01 = 0
728: if ( 0 .le. -0 ) ivon01 = 1
729: go to 45240
730: 35240 ivdele = ivdele + 1
731: write (i02,80003) ivtnum
732: if (iczero) 45240, 5251, 45240
733: 45240 if ( ivon01 - 1 ) 25240, 15240, 25240
734: 15240 ivpass = ivpass + 1
735: write (i02,80001) ivtnum
736: go to 5251
737: 25240 ivfail = ivfail + 1
738: ivcomp = ivon01
739: ivcorr = 1
740: write (i02,80004) ivtnum, ivcomp ,ivcorr
741: 5251 continue
742: ivtnum = 525
743: c
744: c **** test 525 ****
745: c test 525 - test of signed zero .eq. true path
746: c
747: c
748: if (iczero) 35250, 5250, 35250
749: 5250 continue
750: ivon01 = 0
751: if ( 0 .eq. -0 ) ivon01 = 1
752: go to 45250
753: 35250 ivdele = ivdele + 1
754: write (i02,80003) ivtnum
755: if (iczero) 45250, 5261, 45250
756: 45250 if ( ivon01 - 1 ) 25250, 15250, 25250
757: 15250 ivpass = ivpass + 1
758: write (i02,80001) ivtnum
759: go to 5261
760: 25250 ivfail = ivfail + 1
761: ivcomp = ivon01
762: ivcorr = 1
763: write (i02,80004) ivtnum, ivcomp ,ivcorr
764: 5261 continue
765: ivtnum = 526
766: c
767: c **** test 526 ****
768: c test 526 - test of signed zero .ne. false path
769: c
770: c
771: if (iczero) 35260, 5260, 35260
772: 5260 continue
773: ivon01 = 1
774: if ( 0 .ne. -0 ) ivon01 = 0
775: go to 45260
776: 35260 ivdele = ivdele + 1
777: write (i02,80003) ivtnum
778: if (iczero) 45260, 5271, 45260
779: 45260 if ( ivon01 - 1 ) 25260, 15260, 25260
780: 15260 ivpass = ivpass + 1
781: write (i02,80001) ivtnum
782: go to 5271
783: 25260 ivfail = ivfail + 1
784: ivcomp = ivon01
785: ivcorr = 1
786: write (i02,80004) ivtnum, ivcomp ,ivcorr
787: 5271 continue
788: ivtnum = 527
789: c
790: c **** test 527 ****
791: c test 527 - test of signed zero .ge. true path
792: c
793: c
794: if (iczero) 35270, 5270, 35270
795: 5270 continue
796: ivon01 = 0
797: if ( 0 .ge. -0 ) ivon01 = 1
798: go to 45270
799: 35270 ivdele = ivdele + 1
800: write (i02,80003) ivtnum
801: if (iczero) 45270, 5281, 45270
802: 45270 if ( ivon01 - 1 ) 25270, 15270, 25270
803: 15270 ivpass = ivpass + 1
804: write (i02,80001) ivtnum
805: go to 5281
806: 25270 ivfail = ivfail + 1
807: ivcomp = ivon01
808: ivcorr = 1
809: write (i02,80004) ivtnum, ivcomp ,ivcorr
810: 5281 continue
811: ivtnum = 528
812: c
813: c **** test 528 ****
814: c test 528 - test of signed zero .gt. false path
815: c
816: c
817: if (iczero) 35280, 5280, 35280
818: 5280 continue
819: ivon01 = 1
820: if ( 0 .gt. -0 ) ivon01 = 0
821: go to 45280
822: 35280 ivdele = ivdele + 1
823: write (i02,80003) ivtnum
824: if (iczero) 45280, 5291, 45280
825: 45280 if ( ivon01 - 1 ) 25280, 15280, 25280
826: 15280 ivpass = ivpass + 1
827: write (i02,80001) ivtnum
828: go to 5291
829: 25280 ivfail = ivfail + 1
830: ivcomp = ivon01
831: ivcorr = 1
832: write (i02,80004) ivtnum, ivcomp ,ivcorr
833: 5291 continue
834: ivtnum = 529
835: c
836: c **** test 529 ****
837: c test 529 - test of 32767 and -32766 .gt. true path
838: c
839: c
840: if (iczero) 35290, 5290, 35290
841: 5290 continue
842: ivon01 = 0
843: if ( 32767 .gt. -32766 ) ivon01 = 1
844: go to 45290
845: 35290 ivdele = ivdele + 1
846: write (i02,80003) ivtnum
847: if (iczero) 45290, 5301, 45290
848: 45290 if ( ivon01 - 1 ) 25290, 15290, 25290
849: 15290 ivpass = ivpass + 1
850: write (i02,80001) ivtnum
851: go to 5301
852: 25290 ivfail = ivfail + 1
853: ivcomp = ivon01
854: ivcorr = 1
855: write (i02,80004) ivtnum, ivcomp ,ivcorr
856: 5301 continue
857: c
858: c write page footings and run summaries
859: 99999 continue
860: write (i02,90002)
861: write (i02,90006)
862: write (i02,90002)
863: write (i02,90002)
864: write (i02,90007)
865: write (i02,90002)
866: write (i02,90008) ivfail
867: write (i02,90009) ivpass
868: write (i02,90010) ivdele
869: c
870: c
871: c terminate routine execution
872: stop
873: c
874: c format statements for page headers
875: 90000 format (1h1)
876: 90002 format (1h )
877: 90001 format (1h ,10x,34hfortran compiler validation system)
878: 90003 format (1h ,21x,11hversion 1.0)
879: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
880: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
881: 90006 format (1h ,5x,46h----------------------------------------------)
882: 90011 format (1h ,18x,17hsubset level test)
883: c
884: c format statements for run summaries
885: 90008 format (1h ,15x,i5,19h errors encountered)
886: 90009 format (1h ,15x,i5,13h tests passed)
887: 90010 format (1h ,15x,i5,14h tests deleted)
888: c
889: c format statements for test results
890: 80001 format (1h ,4x,i5,7x,4hpass)
891: 80002 format (1h ,4x,i5,7x,4hfail)
892: 80003 format (1h ,4x,i5,7x,7hdeleted)
893: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
894: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
895: c
896: 90007 format (1h ,20x,20hend of program fm018)
897: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.