![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm022.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 fm022.f CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests |
1.1 root 1: c comment section.
2: c
3: c fm022
4: c
5: c this routine tests arrays with fixed dimension and size limits
6: c set either in a blank common or dimension statement. the values
7: c of the array elements are set in various ways such as simple
8: c assignment statements, set to the values of other array elements
9: c (either positive or negative), set by integer to real or real to
10: c integer conversion, set by arithmetic expressions, or set by
11: c use of the equivalence statement.
12: c
13: c references
14: c american national standard programming language fortran,
15: c x3.9-1978
16: c
17: c section 8, specification statements
18: c section 8.1, dimension statement
19: c section 8.2, equivalence statement
20: c section 8.3, common statement
21: c section 8.4, type-statements
22: c section 9, data statement
23: c
24: c
25: c
26: common iadn14(5), radn14(5), ladn13(2)
27: c
28: dimension iadn11(5), radn11(5), ladn11(2)
29: dimension iadn12(5), radn12(5), ladn12(2)
30: dimension iadn15(2), radn15(2)
31: dimension iadn16(4), iadn17(4)
32: c
33: integer radn13(5)
34: real iadn13(5)
35: logical ladn11, ladn12, ladn13, lctn01
36: c
37: equivalence (iadn14(1), iadn15(1)), (radn14(2),radn15(2))
38: equivalence (ladn13(1),lctn01), (iadn14(5), icon02)
39: equivalence (radn14(5), rcon01)
40: equivalence ( iadn16(3), iadn17(2) )
41: c
42: data iadn12(1)/3/, radn12(1)/-512./, iadn13(1)/0.5/, radn13(1)/-3/
43: c
44: c
45: c
46: c **********************************************************
47: c
48: c a compiler validation system for the fortran language
49: c based on specifications as defined in american national standard
50: c programming language fortran x3.9-1978, has been developed by the
51: c federal cobol compiler testing service. the fortran compiler
52: c validation system (fcvs) consists of audit routines, their related
53: c data, and an executive system. each audit routine is a fortran
54: c program, subprogram or function which includes tests of specific
55: c language elements and supporting procedures indicating the result
56: c of executing these tests.
57: c
58: c this particular program/subprogram/function contains features
59: c found only in the subset as defined in x3.9-1978.
60: c
61: c suggestions and comments should be forwarded to -
62: c
63: c department of the navy
64: c federal cobol compiler testing service
65: c washington, d.c. 20376
66: c
67: c **********************************************************
68: c
69: c
70: c
71: c initialization section
72: c
73: c initialize constants
74: c **************
75: c i01 contains the logical unit number for the card reader.
76: i01 = 5
77: c i02 contains the logical unit number for the printer.
78: i02 = 6
79: c system environment section
80: c
81: cx010 this card is replaced by contents of fexec x-010 control card.
82: c the cx010 card is for overriding the program default i01 = 5
83: c (unit number for card reader).
84: cx011 this card is replaced by contents of fexec x-011 control card.
85: c the cx011 card is for systems which require additional
86: c fortran statements for files associated with cx010 above.
87: c
88: cx020 this card is replaced by contents of fexec x-020 control card.
89: c the cx020 card is for overriding the program default i02 = 6
90: c (unit number for printer).
91: cx021 this card is replaced by contents of fexec x-021 control card.
92: c the cx021 card is for systems which require additional
93: c fortran statements for files associated with cx020 above.
94: c
95: ivpass=0
96: ivfail=0
97: ivdele=0
98: iczero=0
99: c
100: c write page headers
101: write (i02,90000)
102: write (i02,90001)
103: write (i02,90002)
104: write (i02, 90002)
105: write (i02,90003)
106: write (i02,90002)
107: write (i02,90004)
108: write (i02,90002)
109: write (i02,90011)
110: write (i02,90002)
111: write (i02,90002)
112: write (i02,90005)
113: write (i02,90006)
114: write (i02,90002)
115: ivtnum = 604
116: c
117: c **** test 604 ****
118: c test 604 - this tests a simple assignment statement in setting
119: c an integer array element to a positive value of 32767.
120: c
121: if (iczero) 36040, 6040, 36040
122: 6040 continue
123: iadn11(5) = 32767
124: ivcomp = iadn11(5)
125: go to 46040
126: 36040 ivdele = ivdele + 1
127: write (i02,80003) ivtnum
128: if (iczero) 46040, 6051, 46040
129: 46040 if ( ivcomp - 32767 ) 26040, 16040, 26040
130: 16040 ivpass = ivpass + 1
131: write (i02,80001) ivtnum
132: go to 6051
133: 26040 ivfail = ivfail + 1
134: ivcorr = 32767
135: write (i02,80004) ivtnum, ivcomp ,ivcorr
136: 6051 continue
137: ivtnum = 605
138: c
139: c **** test 605 ****
140: c test 605 - test of a simple assign with a negative value -32766
141: c
142: if (iczero) 36050, 6050, 36050
143: 6050 continue
144: iadn11(1) = -32766
145: ivcomp = iadn11(1)
146: go to 46050
147: 36050 ivdele = ivdele + 1
148: write (i02,80003) ivtnum
149: if (iczero) 46050, 6061, 46050
150: 46050 if ( ivcomp + 32766 ) 26050, 16050, 26050
151: 16050 ivpass = ivpass + 1
152: write (i02,80001) ivtnum
153: go to 6061
154: 26050 ivfail = ivfail + 1
155: ivcorr = -32766
156: write (i02,80004) ivtnum, ivcomp ,ivcorr
157: 6061 continue
158: ivtnum = 606
159: c
160: c **** test 606 ****
161: c test 606 - test of unsigned zero set to an array element
162: c by a simple assignment statement.
163: c
164: if (iczero) 36060, 6060, 36060
165: 6060 continue
166: iadn11(3) = 0
167: ivcomp = iadn11(3)
168: go to 46060
169: 36060 ivdele = ivdele + 1
170: write (i02,80003) ivtnum
171: if (iczero) 46060, 6071, 46060
172: 46060 if ( ivcomp - 0 ) 26060, 16060, 26060
173: 16060 ivpass = ivpass + 1
174: write (i02,80001) ivtnum
175: go to 6071
176: 26060 ivfail = ivfail + 1
177: ivcorr = 0
178: write (i02,80004) ivtnum, ivcomp ,ivcorr
179: 6071 continue
180: ivtnum = 607
181: c
182: c **** test 607 ****
183: c test 607 - test of a negatively signed zero compared to a
184: c zero unsigned both values set as integer array elements.
185: c
186: if (iczero) 36070, 6070, 36070
187: 6070 continue
188: iadn11(2) = -0
189: iadn11(3) = 0
190: icon01 = 0
191: if ( iadn11(2) .eq. iadn11(3) ) icon01 = 1
192: go to 46070
193: 36070 ivdele = ivdele + 1
194: write (i02,80003) ivtnum
195: if (iczero) 46070, 6081, 46070
196: 46070 if ( icon01 - 1 ) 26070, 16070, 26070
197: 16070 ivpass = ivpass + 1
198: write (i02,80001) ivtnum
199: go to 6081
200: 26070 ivfail = ivfail + 1
201: ivcomp = icon01
202: ivcorr = 1
203: write (i02,80004) ivtnum, ivcomp ,ivcorr
204: 6081 continue
205: ivtnum = 608
206: c
207: c **** test 608 ****
208: c test 608 - test of setting one integer array element equal to
209: c the value of another integer array element. the value is 32767.
210: c
211: if (iczero) 36080, 6080, 36080
212: 6080 continue
213: iadn11(1) = 32767
214: iadn12(5) = iadn11(1)
215: ivcomp = iadn12(5)
216: go to 46080
217: 36080 ivdele = ivdele + 1
218: write (i02,80003) ivtnum
219: if (iczero) 46080, 6091, 46080
220: 46080 if ( ivcomp - 32767 ) 26080, 16080, 26080
221: 16080 ivpass = ivpass + 1
222: write (i02,80001) ivtnum
223: go to 6091
224: 26080 ivfail = ivfail + 1
225: ivcorr = 32767
226: write (i02,80004) ivtnum, ivcomp ,ivcorr
227: 6091 continue
228: ivtnum = 609
229: c
230: c **** test 609 ****
231: c test 609 - test of an array element set to another array element
232: c which had been set at compile time by a data initialization
233: c statement. an integer array is used with the value 3.
234: c
235: if (iczero) 36090, 6090, 36090
236: 6090 continue
237: iadn11(4) = iadn12(1)
238: ivcomp = iadn11(4)
239: go to 46090
240: 36090 ivdele = ivdele + 1
241: write (i02,80003) ivtnum
242: if (iczero) 46090, 6101, 46090
243: 46090 if ( ivcomp - 3 ) 26090, 16090, 26090
244: 16090 ivpass = ivpass + 1
245: write (i02,80001) ivtnum
246: go to 6101
247: 26090 ivfail = ivfail + 1
248: ivcorr = 3
249: write (i02,80004) ivtnum, ivcomp ,ivcorr
250: 6101 continue
251: ivtnum = 610
252: c
253: c **** test 610 ****
254: c test 610 - test of setting a real array element to a positive
255: c value in a simple assignment statement. value is 32767.
256: c
257: if (iczero) 36100, 6100, 36100
258: 6100 continue
259: radn11(5) = 32767.
260: ivcomp = radn11(5)
261: go to 46100
262: 36100 ivdele = ivdele + 1
263: write (i02,80003) ivtnum
264: if (iczero) 46100, 6111, 46100
265: 46100 if ( ivcomp - 32767 ) 26100, 16100, 26100
266: 16100 ivpass = ivpass + 1
267: write (i02,80001) ivtnum
268: go to 6111
269: 26100 ivfail = ivfail + 1
270: ivcorr = 32767
271: write (i02,80004) ivtnum, ivcomp ,ivcorr
272: 6111 continue
273: ivtnum = 611
274: c
275: c **** test 611 ****
276: c test 611 - test of setting a real array element to a negative
277: c value in a simple assignment statement. value is -32766.
278: c
279: if (iczero) 36110, 6110, 36110
280: 6110 continue
281: radn11(1) = -32766.
282: ivcomp = radn11(1)
283: go to 46110
284: 36110 ivdele = ivdele + 1
285: write (i02,80003) ivtnum
286: if (iczero) 46110, 6121, 46110
287: 46110 if ( ivcomp + 32766 ) 26110, 16110, 26110
288: 16110 ivpass = ivpass + 1
289: write (i02,80001) ivtnum
290: go to 6121
291: 26110 ivfail = ivfail + 1
292: ivcorr = -32766
293: write (i02,80004) ivtnum, ivcomp ,ivcorr
294: 6121 continue
295: ivtnum = 612
296: c
297: c **** test 612 ****
298: c test 612 - test of setting a real array element to unsigned zero
299: c in a simple assignment statement.
300: c
301: if (iczero) 36120, 6120, 36120
302: 6120 continue
303: radn11(3) = 0.
304: ivcomp = radn11(3)
305: go to 46120
306: 36120 ivdele = ivdele + 1
307: write (i02,80003) ivtnum
308: if (iczero) 46120, 6131, 46120
309: 46120 if ( ivcomp - 0 ) 26120, 16120, 26120
310: 16120 ivpass = ivpass + 1
311: write (i02,80001) ivtnum
312: go to 6131
313: 26120 ivfail = ivfail + 1
314: ivcorr = 0
315: write (i02,80004) ivtnum, ivcomp ,ivcorr
316: 6131 continue
317: ivtnum = 613
318: c
319: c **** test 613 ****
320: c test 613 - test of a negatively signed zero in a real array
321: c element compared to a real element set to an unsigned zero.
322: c
323: if (iczero) 36130, 6130, 36130
324: 6130 continue
325: radn11(2) = -0.0
326: radn11(3) = 0.0
327: icon01 = 0
328: if ( radn11(2) .eq. radn11(3) ) icon01 = 1
329: go to 46130
330: 36130 ivdele = ivdele + 1
331: write (i02,80003) ivtnum
332: if (iczero) 46130, 6141, 46130
333: 46130 if ( icon01 - 1 ) 26130, 16130, 26130
334: 16130 ivpass = ivpass + 1
335: write (i02,80001) ivtnum
336: go to 6141
337: 26130 ivfail = ivfail + 1
338: ivcomp = icon01
339: ivcorr = 1
340: write (i02,80004) ivtnum, ivcomp ,ivcorr
341: 6141 continue
342: ivtnum = 614
343: c
344: c **** test 614 ****
345: c test 614 - test of setting one real array element equal to the
346: c value of another real array element. the value is 32767.
347: c
348: if (iczero) 36140, 6140, 36140
349: 6140 continue
350: radn11(1) = 32767.
351: radn12(5) = radn11(1)
352: ivcomp = radn12(5)
353: go to 46140
354: 36140 ivdele = ivdele + 1
355: write (i02,80003) ivtnum
356: if (iczero) 46140, 6151, 46140
357: 46140 if ( ivcomp - 32767 ) 26140, 16140, 26140
358: 16140 ivpass = ivpass + 1
359: write (i02,80001) ivtnum
360: go to 6151
361: 26140 ivfail = ivfail + 1
362: ivcorr = 32767
363: write (i02,80004) ivtnum, ivcomp ,ivcorr
364: 6151 continue
365: ivtnum = 615
366: c
367: c **** test 615 ****
368: c test 615 - test of a real array element set to another real
369: c array element which had been set at compile time by a data
370: c initialization statement. the value is -512.
371: c
372: if (iczero) 36150, 6150, 36150
373: 6150 continue
374: radn11(4) = radn12(1)
375: ivcomp = radn11(4)
376: go to 46150
377: 36150 ivdele = ivdele + 1
378: write (i02,80003) ivtnum
379: if (iczero) 46150, 6161, 46150
380: 46150 if ( ivcomp + 512 ) 26150, 16150, 26150
381: 16150 ivpass = ivpass + 1
382: write (i02,80001) ivtnum
383: go to 6161
384: 26150 ivfail = ivfail + 1
385: ivcorr = - 512
386: write (i02,80004) ivtnum, ivcomp ,ivcorr
387: 6161 continue
388: ivtnum = 616
389: c
390: c **** test 616 ****
391: c test 616 - test of setting the value of an integer array element
392: c by an arithmetic expression.
393: c
394: if (iczero) 36160, 6160, 36160
395: 6160 continue
396: icon01 = 1
397: iadn11(3) = icon01 + 1
398: ivcomp = iadn11(3)
399: go to 46160
400: 36160 ivdele = ivdele + 1
401: write (i02,80003) ivtnum
402: if (iczero) 46160, 6171, 46160
403: 46160 if ( ivcomp - 2 ) 26160, 16160, 26160
404: 16160 ivpass = ivpass + 1
405: write (i02,80001) ivtnum
406: go to 6171
407: 26160 ivfail = ivfail + 1
408: ivcorr = 2
409: write (i02,80004) ivtnum, ivcomp ,ivcorr
410: 6171 continue
411: ivtnum = 617
412: c
413: c **** test 617 ****
414: c test 617 - test of setting the value of a real array element
415: c by an arithmetic expression.
416: c
417: if (iczero) 36170, 6170, 36170
418: 6170 continue
419: rcon01 = 1.
420: radn11(3) = rcon01 + 1.
421: ivcomp = radn11(3)
422: go to 46170
423: 36170 ivdele = ivdele + 1
424: write (i02,80003) ivtnum
425: if (iczero) 46170, 6181, 46170
426: 46170 if ( ivcomp - 2 ) 26170, 16170, 26170
427: 16170 ivpass = ivpass + 1
428: write (i02,80001) ivtnum
429: go to 6181
430: 26170 ivfail = ivfail + 1
431: ivcorr = 2
432: write (i02,80004) ivtnum, ivcomp ,ivcorr
433: 6181 continue
434: ivtnum = 618
435: c
436: c **** test 618 ****
437: c test 618 - test of setting the value of an integer array element
438: c to another integer array element and changing the sign.
439: c
440: if (iczero) 36180, 6180, 36180
441: 6180 continue
442: iadn11(2) = 32766
443: iadn11(4) = - iadn11(2)
444: ivcomp = iadn11(4)
445: go to 46180
446: 36180 ivdele = ivdele + 1
447: write (i02,80003) ivtnum
448: if (iczero) 46180, 6191, 46180
449: 46180 if ( ivcomp + 32766 ) 26180, 16180, 26180
450: 16180 ivpass = ivpass + 1
451: write (i02,80001) ivtnum
452: go to 6191
453: 26180 ivfail = ivfail + 1
454: ivcorr = -32766
455: write (i02,80004) ivtnum, ivcomp ,ivcorr
456: 6191 continue
457: ivtnum = 619
458: c
459: c **** test 619 ****
460: c test 619 - test of setting the value of a real array element
461: c to the value of another real array element and changing the sign.
462: c
463: if (iczero) 36190, 6190, 36190
464: 6190 continue
465: radn11(2) = 32766.
466: radn11(4) = - radn11(2)
467: ivcomp = radn11(4)
468: go to 46190
469: 36190 ivdele = ivdele + 1
470: write (i02,80003) ivtnum
471: if (iczero) 46190, 6201, 46190
472: 46190 if ( ivcomp + 32766 ) 26190, 16190, 26190
473: 16190 ivpass = ivpass + 1
474: write (i02,80001) ivtnum
475: go to 6201
476: 26190 ivfail = ivfail + 1
477: ivcorr = -32766
478: write (i02,80004) ivtnum, ivcomp ,ivcorr
479: 6201 continue
480: ivtnum = 620
481: c
482: c **** test 620 ****
483: c test 620 - test of setting the value of a logical array element
484: c to the value of another logical array element.
485: c
486: if (iczero) 36200, 6200, 36200
487: 6200 continue
488: ladn11(1) = .true.
489: ladn12(1) = ladn11(1)
490: icon01 = 0
491: if ( ladn12(1) ) icon01 = 1
492: go to 46200
493: 36200 ivdele = ivdele + 1
494: write (i02,80003) ivtnum
495: if (iczero) 46200, 6211, 46200
496: 46200 if ( icon01 - 1 ) 26200, 16200, 26200
497: 16200 ivpass = ivpass + 1
498: write (i02,80001) ivtnum
499: go to 6211
500: 26200 ivfail = ivfail + 1
501: ivcomp = icon01
502: ivcorr = 1
503: write (i02,80004) ivtnum, ivcomp ,ivcorr
504: 6211 continue
505: ivtnum = 621
506: c
507: c **** test 621 ****
508: c test 621 - test of setting the value of a logical array element
509: c to the value of another logical array element and changing
510: c the value from .true. to .false. by using the .not. statement.
511: c
512: if (iczero) 36210, 6210, 36210
513: 6210 continue
514: ladn11(2) = .true.
515: ladn12(2) = .not. ladn11(2)
516: icon01 = 1
517: if ( ladn12(2) ) icon01 = 0
518: go to 46210
519: 36210 ivdele = ivdele + 1
520: write (i02,80003) ivtnum
521: if (iczero) 46210, 6221, 46210
522: 46210 if ( icon01 - 1 ) 26210, 16210, 26210
523: 16210 ivpass = ivpass + 1
524: write (i02,80001) ivtnum
525: go to 6221
526: 26210 ivfail = ivfail + 1
527: ivcomp = icon01
528: ivcorr = 1
529: write (i02,80004) ivtnum, ivcomp ,ivcorr
530: 6221 continue
531: ivtnum = 622
532: c
533: c **** test 622 ****
534: c test 622 - test of the type statement and the data
535: c initialization statement. the explicitly real array element
536: c should have the value of .5
537: c
538: if (iczero) 36220, 6220, 36220
539: 6220 continue
540: ivcomp = 2. * iadn13(1)
541: go to 46220
542: 36220 ivdele = ivdele + 1
543: write (i02,80003) ivtnum
544: if (iczero) 46220, 6231, 46220
545: 46220 if ( ivcomp - 1 ) 26220, 16220, 26220
546: 16220 ivpass = ivpass + 1
547: write (i02,80001) ivtnum
548: go to 6231
549: 26220 ivfail = ivfail + 1
550: ivcorr = 1
551: write (i02,80004) ivtnum, ivcomp ,ivcorr
552: 6231 continue
553: ivtnum = 623
554: c
555: c **** test 623 ****
556: c test 623 - test of real to integer conversion using arrays.
557: c the initialized value of 0.5 should be truncated to zero.
558: c
559: if (iczero) 36230, 6230, 36230
560: 6230 continue
561: iadn11(1) = iadn13(1)
562: ivcomp = iadn11(1)
563: go to 46230
564: 36230 ivdele = ivdele + 1
565: write (i02,80003) ivtnum
566: if (iczero) 46230, 6241, 46230
567: 46230 if ( ivcomp - 0 ) 26230, 16230, 26230
568: 16230 ivpass = ivpass + 1
569: write (i02,80001) ivtnum
570: go to 6241
571: 26230 ivfail = ivfail + 1
572: ivcorr = 0
573: write (i02,80004) ivtnum, ivcomp ,ivcorr
574: 6241 continue
575: ivtnum = 624
576: c
577: c **** test 624 ****
578: c test 624 - test of the common statement by setting the value of
579: c an integer array element in a dimensioned array to the value
580: c of a real array element in common. the element in common had its
581: c value set in a simple assignment statement to 9999.
582: c
583: if (iczero) 36240, 6240, 36240
584: 6240 continue
585: radn14(1) = 9999.
586: iadn11(1) = radn14(1)
587: ivcomp = iadn11(1)
588: go to 46240
589: 36240 ivdele = ivdele + 1
590: write (i02,80003) ivtnum
591: if (iczero) 46240, 6251, 46240
592: 46240 if ( ivcomp - 9999 ) 26240, 16240, 26240
593: 16240 ivpass = ivpass + 1
594: write (i02,80001) ivtnum
595: go to 6251
596: 26240 ivfail = ivfail + 1
597: ivcorr = 9999
598: write (i02,80004) ivtnum, ivcomp ,ivcorr
599: 6251 continue
600: ivtnum = 625
601: c
602: c **** test 625 ****
603: c test 625 - test of setting the value of an integer array element
604: c in common to the value of a real array element also in blank
605: c common and changing the sign. the value used is 9999.
606: c
607: if (iczero) 36250, 6250, 36250
608: 6250 continue
609: radn14(1) = 9999.
610: iadn14(1) = - radn14(1)
611: ivcomp = iadn14(1)
612: go to 46250
613: 36250 ivdele = ivdele + 1
614: write (i02,80003) ivtnum
615: if (iczero) 46250, 6261, 46250
616: 46250 if ( ivcomp + 9999 ) 26250, 16250, 26250
617: 16250 ivpass = ivpass + 1
618: write (i02,80001) ivtnum
619: go to 6261
620: 26250 ivfail = ivfail + 1
621: ivcorr = - 9999
622: write (i02,80004) ivtnum, ivcomp ,ivcorr
623: 6261 continue
624: ivtnum = 626
625: c
626: c **** test 626 ****
627: c test 626 - test of setting the value of a logical array element
628: c in blank common to .not. .true.
629: c the value of another logical array element also in common is then
630: c set to .not. of the value of the first.
631: c value of the first element should be .false.
632: c value of the second element should be .true.
633: c
634: if (iczero) 36260, 6260, 36260
635: 6260 continue
636: ladn13(1) = .not. .true.
637: ladn13(2) = .not. ladn13(1)
638: icon01 = 0
639: if ( ladn13(2) ) icon01 = 1
640: go to 46260
641: 36260 ivdele = ivdele + 1
642: write (i02,80003) ivtnum
643: if (iczero) 46260, 6271, 46260
644: 46260 if ( icon01 - 1 ) 26260, 16260, 26260
645: 16260 ivpass = ivpass + 1
646: write (i02,80001) ivtnum
647: go to 6271
648: 26260 ivfail = ivfail + 1
649: ivcomp = icon01
650: ivcorr = 1
651: write (i02,80004) ivtnum, ivcomp ,ivcorr
652: 6271 continue
653: ivtnum = 627
654: c
655: c **** test 627 ****
656: c test 627 - test of equivalence on the first elements of integer
657: c arrays one of which is in common and the other one is dimensioned.
658: c
659: if (iczero) 36270, 6270, 36270
660: 6270 continue
661: iadn14(2) = 32767
662: ivcomp = iadn15(2)
663: go to 46270
664: 36270 ivdele = ivdele + 1
665: write (i02,80003) ivtnum
666: if (iczero) 46270, 6281, 46270
667: 46270 if ( ivcomp - 32767 ) 26270, 16270, 26270
668: 16270 ivpass = ivpass + 1
669: write (i02,80001) ivtnum
670: go to 6281
671: 26270 ivfail = ivfail + 1
672: ivcorr = 32767
673: write (i02,80004) ivtnum, ivcomp ,ivcorr
674: 6281 continue
675: ivtnum = 628
676: c
677: c **** test 628 ****
678: c test 628 - test of equivalence on real arrays one of which is
679: c in common and the other one is dimensioned. the arrays were
680: c aligned on their second elements.
681: c
682: if (iczero) 36280, 6280, 36280
683: 6280 continue
684: radn15(1) = -32766.
685: ivcomp = radn14(1)
686: go to 46280
687: 36280 ivdele = ivdele + 1
688: write (i02,80003) ivtnum
689: if (iczero) 46280, 6291, 46280
690: 46280 if ( ivcomp + 32766 ) 26280, 16280, 26280
691: 16280 ivpass = ivpass + 1
692: write (i02,80001) ivtnum
693: go to 6291
694: 26280 ivfail = ivfail + 1
695: ivcorr = -32766
696: write (i02,80004) ivtnum, ivcomp ,ivcorr
697: 6291 continue
698: ivtnum = 629
699: c
700: c **** test 629 ****
701: c test 629 - test of equivalence with logical elements. an array
702: c element in common is equivalenced to a logical variable.
703: c
704: if (iczero) 36290, 6290, 36290
705: 6290 continue
706: ladn13(2) = .true.
707: lctn01 = .not. ladn13(2)
708: icon01 = 1
709: if ( ladn13(1) ) icon01 = 0
710: go to 46290
711: 36290 ivdele = ivdele + 1
712: write (i02,80003) ivtnum
713: if (iczero) 46290, 6301, 46290
714: 46290 if ( icon01 - 1 ) 26290, 16290, 26290
715: 16290 ivpass = ivpass + 1
716: write (i02,80001) ivtnum
717: go to 6301
718: 26290 ivfail = ivfail + 1
719: ivcomp = icon01
720: ivcorr = 1
721: write (i02,80004) ivtnum, ivcomp ,ivcorr
722: 6301 continue
723: ivtnum = 630
724: c
725: c **** test 630 ****
726: c test 630 - test of equivalence with real and integer elements
727: c which are equivalenced to array elements in common.
728: c
729: if (iczero) 36300, 6300, 36300
730: 6300 continue
731: rcon01 = 1.
732: icon02 = - radn14(5)
733: ivcomp = iadn14(5)
734: go to 46300
735: 36300 ivdele = ivdele + 1
736: write (i02,80003) ivtnum
737: if (iczero) 46300, 6311, 46300
738: 46300 if ( ivcomp + 1 ) 26300, 16300, 26300
739: 16300 ivpass = ivpass + 1
740: write (i02,80001) ivtnum
741: go to 6311
742: 26300 ivfail = ivfail + 1
743: ivcorr = -1
744: write (i02,80004) ivtnum, ivcomp ,ivcorr
745: 6311 continue
746: ivtnum = 631
747: c
748: c **** test 631 ****
749: c test 631 - test of equivalence on integer array elements.
750: c both arrays are dimensioned. the fourth element
751: c of the first of the arrays should be equal to the third element of
752: c the second array.
753: c
754: if (iczero) 36310, 6310, 36310
755: 6310 continue
756: iadn16(4) = 9999
757: ivcomp = iadn17(3)
758: go to 46310
759: 36310 ivdele = ivdele + 1
760: write (i02,80003) ivtnum
761: if (iczero) 46310, 6321, 46310
762: 46310 if ( ivcomp - 9999 ) 26310, 16310, 26310
763: 16310 ivpass = ivpass + 1
764: write (i02,80001) ivtnum
765: go to 6321
766: 26310 ivfail = ivfail + 1
767: ivcorr = 9999
768: write (i02,80004) ivtnum, ivcomp ,ivcorr
769: 6321 continue
770: c
771: c write page footings and run summaries
772: 99999 continue
773: write (i02,90002)
774: write (i02,90006)
775: write (i02,90002)
776: write (i02,90002)
777: write (i02,90007)
778: write (i02,90002)
779: write (i02,90008) ivfail
780: write (i02,90009) ivpass
781: write (i02,90010) ivdele
782: c
783: c
784: c terminate routine execution
785: stop
786: c
787: c format statements for page headers
788: 90000 format (1h1)
789: 90002 format (1h )
790: 90001 format (1h ,10x,34hfortran compiler validation system)
791: 90003 format (1h ,21x,11hversion 1.0)
792: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
793: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
794: 90006 format (1h ,5x,46h----------------------------------------------)
795: 90011 format (1h ,18x,17hsubset level test)
796: c
797: c format statements for run summaries
798: 90008 format (1h ,15x,i5,19h errors encountered)
799: 90009 format (1h ,15x,i5,13h tests passed)
800: 90010 format (1h ,15x,i5,14h tests deleted)
801: c
802: c format statements for test results
803: 80001 format (1h ,4x,i5,7x,4hpass)
804: 80002 format (1h ,4x,i5,7x,4hfail)
805: 80003 format (1h ,4x,i5,7x,7hdeleted)
806: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
807: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
808: c
809: 90007 format (1h ,20x,20hend of program fm022)
810: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.