Remove old autovect-branch by moving to "dead" directory.
[official-gcc.git] / old-autovect-branch / gcc / testsuite / gfortran.dg / cray_pointers_2.f90
blob7c958d57b0a0242c63eff31d04abfcc293b70444
1 ! { dg-do run }
2 ! { dg-options "-fcray-pointer" }
3 ! Series of routines for testing a Cray pointer implementation
4 program craytest
5 common /errors/errors(400)
6 common /foo/foo ! To prevent optimizations
7 integer foo
8 integer i
9 logical errors
10 errors = .false.
11 foo = 0
12 call ptr1
13 call ptr2
14 call ptr3
15 call ptr4
16 call ptr5
17 call ptr6
18 call ptr7
19 call ptr8
20 call ptr9(9,10,11)
21 call ptr10(9,10,11)
22 call ptr11(9,10,11)
23 call ptr12(9,10,11)
24 call ptr13(9,10)
25 call parmtest
26 ! NOTE: Tests 1 through 12 were removed from this file
27 ! and placed in loc_1.f90, so we start at 13
28 do i=13,400
29 if (errors(i)) then
30 ! print *,"Test",i,"failed."
31 call abort()
32 endif
33 end do
34 if (foo.eq.0) then
35 ! print *,"Test did not run correctly."
36 call abort()
37 endif
38 end program craytest
40 ! ptr1 through ptr13 that Cray pointees are correctly used with
41 ! a variety of declaration styles
42 subroutine ptr1
43 common /errors/errors(400)
44 logical :: errors, intne, realne, chne, ch8ne
45 integer :: i,j,k
46 integer, parameter :: n = 9
47 integer, parameter :: m = 10
48 integer, parameter :: o = 11
49 integer itarg1 (n)
50 integer itarg2 (m,n)
51 integer itarg3 (o,m,n)
52 real rtarg1(n)
53 real rtarg2(m,n)
54 real rtarg3(o,m,n)
55 character chtarg1(n)
56 character chtarg2(m,n)
57 character chtarg3(o,m,n)
58 character*8 ch8targ1(n)
59 character*8 ch8targ2(m,n)
60 character*8 ch8targ3(o,m,n)
61 type drvd
62 real r1
63 integer i1
64 integer i2(5)
65 end type drvd
66 type(drvd) dtarg1(n)
67 type(drvd) dtarg2(m,n)
68 type(drvd) dtarg3(o,m,n)
70 type(drvd) dpte1(n)
71 type(drvd) dpte2(m,n)
72 type(drvd) dpte3(o,m,n)
73 integer ipte1 (n)
74 integer ipte2 (m,n)
75 integer ipte3 (o,m,n)
76 real rpte1(n)
77 real rpte2(m,n)
78 real rpte3(o,m,n)
79 character chpte1(n)
80 character chpte2(m,n)
81 character chpte3(o,m,n)
82 character*8 ch8pte1(n)
83 character*8 ch8pte2(m,n)
84 character*8 ch8pte3(o,m,n)
86 pointer(iptr1,dpte1)
87 pointer(iptr2,dpte2)
88 pointer(iptr3,dpte3)
89 pointer(iptr4,ipte1)
90 pointer(iptr5,ipte2)
91 pointer(iptr6,ipte3)
92 pointer(iptr7,rpte1)
93 pointer(iptr8,rpte2)
94 pointer(iptr9,rpte3)
95 pointer(iptr10,chpte1)
96 pointer(iptr11,chpte2)
97 pointer(iptr12,chpte3)
98 pointer(iptr13,ch8pte1)
99 pointer(iptr14,ch8pte2)
100 pointer(iptr15,ch8pte3)
102 iptr1 = loc(dtarg1)
103 iptr2 = loc(dtarg2)
104 iptr3 = loc(dtarg3)
105 iptr4 = loc(itarg1)
106 iptr5 = loc(itarg2)
107 iptr6 = loc(itarg3)
108 iptr7 = loc(rtarg1)
109 iptr8 = loc(rtarg2)
110 iptr9 = loc(rtarg3)
111 iptr10= loc(chtarg1)
112 iptr11= loc(chtarg2)
113 iptr12= loc(chtarg3)
114 iptr13= loc(ch8targ1)
115 iptr14= loc(ch8targ2)
116 iptr15= loc(ch8targ3)
119 do, i=1,n
120 dpte1(i)%i1=i
121 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
122 ! Error #13
123 errors(13) = .true.
124 endif
126 dtarg1(i)%i1=2*dpte1(i)%i1
127 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
128 ! Error #14
129 errors(14) = .true.
130 endif
132 ipte1(i) = i
133 if (intne(ipte1(i), itarg1(i))) then
134 ! Error #15
135 errors(15) = .true.
136 endif
138 itarg1(i) = -ipte1(i)
139 if (intne(ipte1(i), itarg1(i))) then
140 ! Error #16
141 errors(16) = .true.
142 endif
144 rpte1(i) = i * 5.0
145 if (realne(rpte1(i), rtarg1(i))) then
146 ! Error #17
147 errors(17) = .true.
148 endif
150 rtarg1(i) = i * (-5.0)
151 if (realne(rpte1(i), rtarg1(i))) then
152 ! Error #18
153 errors(18) = .true.
154 endif
156 chpte1(i) = 'a'
157 if (chne(chpte1(i), chtarg1(i))) then
158 ! Error #19
159 errors(19) = .true.
160 endif
162 chtarg1(i) = 'z'
163 if (chne(chpte1(i), chtarg1(i))) then
164 ! Error #20
165 errors(20) = .true.
166 endif
168 ch8pte1(i) = 'aaaaaaaa'
169 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
170 ! Error #21
171 errors(21) = .true.
172 endif
174 ch8targ1(i) = 'zzzzzzzz'
175 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
176 ! Error #22
177 errors(22) = .true.
178 endif
180 do, j=1,m
181 dpte2(j,i)%r1=1.0
182 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
183 ! Error #23
184 errors(23) = .true.
185 endif
187 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
188 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
189 ! Error #24
190 errors(24) = .true.
191 endif
193 ipte2(j,i) = i
194 if (intne(ipte2(j,i), itarg2(j,i))) then
195 ! Error #25
196 errors(25) = .true.
197 endif
199 itarg2(j,i) = -ipte2(j,i)
200 if (intne(ipte2(j,i), itarg2(j,i))) then
201 ! Error #26
202 errors(26) = .true.
203 endif
205 rpte2(j,i) = i * (-2.0)
206 if (realne(rpte2(j,i), rtarg2(j,i))) then
207 ! Error #27
208 errors(27) = .true.
209 endif
211 rtarg2(j,i) = i * (-3.0)
212 if (realne(rpte2(j,i), rtarg2(j,i))) then
213 ! Error #28
214 errors(28) = .true.
215 endif
217 chpte2(j,i) = 'a'
218 if (chne(chpte2(j,i), chtarg2(j,i))) then
219 ! Error #29
220 errors(29) = .true.
221 endif
223 chtarg2(j,i) = 'z'
224 if (chne(chpte2(j,i), chtarg2(j,i))) then
225 ! Error #30
226 errors(30) = .true.
227 endif
229 ch8pte2(j,i) = 'aaaaaaaa'
230 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
231 ! Error #31
232 errors(31) = .true.
233 endif
235 ch8targ2(j,i) = 'zzzzzzzz'
236 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
237 ! Error #32
238 errors(32) = .true.
239 endif
240 do k=1,o
241 dpte3(k,j,i)%i2(1+mod(i,5))=i
242 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
243 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
244 ! Error #33
245 errors(33) = .true.
246 endif
248 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
249 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
250 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
251 ! Error #34
252 errors(34) = .true.
253 endif
255 ipte3(k,j,i) = i
256 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
257 ! Error #35
258 errors(35) = .true.
259 endif
261 itarg3(k,j,i) = -ipte3(k,j,i)
262 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
263 ! Error #36
264 errors(36) = .true.
265 endif
267 rpte3(k,j,i) = i * 2.0
268 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
269 ! Error #37
270 errors(37) = .true.
271 endif
273 rtarg3(k,j,i) = i * 3.0
274 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
275 ! Error #38
276 errors(38) = .true.
277 endif
279 chpte3(k,j,i) = 'a'
280 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
281 ! Error #39
282 errors(39) = .true.
283 endif
285 chtarg3(k,j,i) = 'z'
286 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
287 ! Error #40
288 errors(40) = .true.
289 endif
291 ch8pte3(k,j,i) = 'aaaaaaaa'
292 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
293 ! Error #41
294 errors(41) = .true.
295 endif
297 ch8targ3(k,j,i) = 'zzzzzzzz'
298 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
299 ! Error #42
300 errors(42) = .true.
301 endif
302 end do
303 end do
304 end do
306 rtarg3 = .5
307 ! Vector syntax
308 do, i=1,n
309 ipte3 = i
310 rpte3 = rpte3+1
311 do, j=1,m
312 do k=1,o
313 if (intne(itarg3(k,j,i), i)) then
314 ! Error #43
315 errors(43) = .true.
316 endif
318 if (realne(rtarg3(k,j,i), i+.5)) then
319 ! Error #44
320 errors(44) = .true.
321 endif
322 end do
323 end do
324 end do
326 end subroutine ptr1
329 subroutine ptr2
330 common /errors/errors(400)
331 logical :: errors, intne, realne, chne, ch8ne
332 integer :: i,j,k
333 integer, parameter :: n = 9
334 integer, parameter :: m = 10
335 integer, parameter :: o = 11
336 integer itarg1 (n)
337 integer itarg2 (m,n)
338 integer itarg3 (o,m,n)
339 real rtarg1(n)
340 real rtarg2(m,n)
341 real rtarg3(o,m,n)
342 character chtarg1(n)
343 character chtarg2(m,n)
344 character chtarg3(o,m,n)
345 character*8 ch8targ1(n)
346 character*8 ch8targ2(m,n)
347 character*8 ch8targ3(o,m,n)
348 type drvd
349 real r1
350 integer i1
351 integer i2(5)
352 end type drvd
353 type(drvd) dtarg1(n)
354 type(drvd) dtarg2(m,n)
355 type(drvd) dtarg3(o,m,n)
357 type(drvd) dpte1
358 type(drvd) dpte2
359 type(drvd) dpte3
360 integer ipte1
361 integer ipte2
362 integer ipte3
363 real rpte1
364 real rpte2
365 real rpte3
366 character chpte1
367 character chpte2
368 character chpte3
369 character*8 ch8pte1
370 character*8 ch8pte2
371 character*8 ch8pte3
373 pointer(iptr1,dpte1(n))
374 pointer(iptr2,dpte2(m,n))
375 pointer(iptr3,dpte3(o,m,n))
376 pointer(iptr4,ipte1(n))
377 pointer(iptr5,ipte2 (m,n))
378 pointer(iptr6,ipte3(o,m,n))
379 pointer(iptr7,rpte1(n))
380 pointer(iptr8,rpte2(m,n))
381 pointer(iptr9,rpte3(o,m,n))
382 pointer(iptr10,chpte1(n))
383 pointer(iptr11,chpte2(m,n))
384 pointer(iptr12,chpte3(o,m,n))
385 pointer(iptr13,ch8pte1(n))
386 pointer(iptr14,ch8pte2(m,n))
387 pointer(iptr15,ch8pte3(o,m,n))
389 iptr1 = loc(dtarg1)
390 iptr2 = loc(dtarg2)
391 iptr3 = loc(dtarg3)
392 iptr4 = loc(itarg1)
393 iptr5 = loc(itarg2)
394 iptr6 = loc(itarg3)
395 iptr7 = loc(rtarg1)
396 iptr8 = loc(rtarg2)
397 iptr9 = loc(rtarg3)
398 iptr10= loc(chtarg1)
399 iptr11= loc(chtarg2)
400 iptr12= loc(chtarg3)
401 iptr13= loc(ch8targ1)
402 iptr14= loc(ch8targ2)
403 iptr15= loc(ch8targ3)
405 do, i=1,n
406 dpte1(i)%i1=i
407 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
408 ! Error #45
409 errors(45) = .true.
410 endif
412 dtarg1(i)%i1=2*dpte1(i)%i1
413 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
414 ! Error #46
415 errors(46) = .true.
416 endif
418 ipte1(i) = i
419 if (intne(ipte1(i), itarg1(i))) then
420 ! Error #47
421 errors(47) = .true.
422 endif
424 itarg1(i) = -ipte1(i)
425 if (intne(ipte1(i), itarg1(i))) then
426 ! Error #48
427 errors(48) = .true.
428 endif
430 rpte1(i) = i * 5.0
431 if (realne(rpte1(i), rtarg1(i))) then
432 ! Error #49
433 errors(49) = .true.
434 endif
436 rtarg1(i) = i * (-5.0)
437 if (realne(rpte1(i), rtarg1(i))) then
438 ! Error #50
439 errors(50) = .true.
440 endif
442 chpte1(i) = 'a'
443 if (chne(chpte1(i), chtarg1(i))) then
444 ! Error #51
445 errors(51) = .true.
446 endif
448 chtarg1(i) = 'z'
449 if (chne(chpte1(i), chtarg1(i))) then
450 ! Error #52
451 errors(52) = .true.
452 endif
454 ch8pte1(i) = 'aaaaaaaa'
455 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
456 ! Error #53
457 errors(53) = .true.
458 endif
460 ch8targ1(i) = 'zzzzzzzz'
461 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
462 ! Error #54
463 errors(54) = .true.
464 endif
466 do, j=1,m
467 dpte2(j,i)%r1=1.0
468 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
469 ! Error #55
470 errors(55) = .true.
471 endif
473 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
474 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
475 ! Error #56
476 errors(56) = .true.
477 endif
479 ipte2(j,i) = i
480 if (intne(ipte2(j,i), itarg2(j,i))) then
481 ! Error #57
482 errors(57) = .true.
483 endif
485 itarg2(j,i) = -ipte2(j,i)
486 if (intne(ipte2(j,i), itarg2(j,i))) then
487 ! Error #58
488 errors(58) = .true.
489 endif
491 rpte2(j,i) = i * (-2.0)
492 if (realne(rpte2(j,i), rtarg2(j,i))) then
493 ! Error #59
494 errors(59) = .true.
495 endif
497 rtarg2(j,i) = i * (-3.0)
498 if (realne(rpte2(j,i), rtarg2(j,i))) then
499 ! Error #60
500 errors(60) = .true.
501 endif
503 chpte2(j,i) = 'a'
504 if (chne(chpte2(j,i), chtarg2(j,i))) then
505 ! Error #61
506 errors(61) = .true.
507 endif
509 chtarg2(j,i) = 'z'
510 if (chne(chpte2(j,i), chtarg2(j,i))) then
511 ! Error #62
512 errors(62) = .true.
513 endif
515 ch8pte2(j,i) = 'aaaaaaaa'
516 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
517 ! Error #63
518 errors(63) = .true.
519 endif
521 ch8targ2(j,i) = 'zzzzzzzz'
522 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
523 ! Error #64
524 errors(64) = .true.
525 endif
526 do k=1,o
527 dpte3(k,j,i)%i2(1+mod(i,5))=i
528 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then
529 ! Error #65
530 errors(65) = .true.
531 endif
533 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
534 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then
535 ! Error #66
536 errors(66) = .true.
537 endif
539 ipte3(k,j,i) = i
540 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
541 ! Error #67
542 errors(67) = .true.
543 endif
545 itarg3(k,j,i) = -ipte3(k,j,i)
546 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
547 ! Error #68
548 errors(68) = .true.
549 endif
551 rpte3(k,j,i) = i * 2.0
552 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
553 ! Error #69
554 errors(69) = .true.
555 endif
557 rtarg3(k,j,i) = i * 3.0
558 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
559 ! Error #70
560 errors(70) = .true.
561 endif
563 chpte3(k,j,i) = 'a'
564 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
565 ! Error #71
566 errors(71) = .true.
567 endif
569 chtarg3(k,j,i) = 'z'
570 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
571 ! Error #72
572 errors(72) = .true.
573 endif
575 ch8pte3(k,j,i) = 'aaaaaaaa'
576 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
577 ! Error #73
578 errors(73) = .true.
579 endif
581 ch8targ3(k,j,i) = 'zzzzzzzz'
582 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
583 ! Error #74
584 errors(74) = .true.
585 endif
586 end do
587 end do
588 end do
590 rtarg3 = .5
591 ! Vector syntax
592 do, i=1,n
593 ipte3 = i
594 rpte3 = rpte3+1
595 do, j=1,m
596 do k=1,o
597 if (intne(itarg3(k,j,i), i)) then
598 ! Error #75
599 errors(75) = .true.
600 endif
602 if (realne(rtarg3(k,j,i), i+.5)) then
603 ! Error #76
604 errors(76) = .true.
605 endif
606 end do
607 end do
608 end do
609 end subroutine ptr2
611 subroutine ptr3
612 common /errors/errors(400)
613 logical :: errors, intne, realne, chne, ch8ne
614 integer :: i,j,k
615 integer, parameter :: n = 9
616 integer, parameter :: m = 10
617 integer, parameter :: o = 11
618 integer itarg1 (n)
619 integer itarg2 (m,n)
620 integer itarg3 (o,m,n)
621 real rtarg1(n)
622 real rtarg2(m,n)
623 real rtarg3(o,m,n)
624 character chtarg1(n)
625 character chtarg2(m,n)
626 character chtarg3(o,m,n)
627 character*8 ch8targ1(n)
628 character*8 ch8targ2(m,n)
629 character*8 ch8targ3(o,m,n)
630 type drvd
631 real r1
632 integer i1
633 integer i2(5)
634 end type drvd
635 type(drvd) dtarg1(n)
636 type(drvd) dtarg2(m,n)
637 type(drvd) dtarg3(o,m,n)
639 pointer(iptr1,dpte1(n))
640 pointer(iptr2,dpte2(m,n))
641 pointer(iptr3,dpte3(o,m,n))
642 pointer(iptr4,ipte1(n))
643 pointer(iptr5,ipte2 (m,n))
644 pointer(iptr6,ipte3(o,m,n))
645 pointer(iptr7,rpte1(n))
646 pointer(iptr8,rpte2(m,n))
647 pointer(iptr9,rpte3(o,m,n))
648 pointer(iptr10,chpte1(n))
649 pointer(iptr11,chpte2(m,n))
650 pointer(iptr12,chpte3(o,m,n))
651 pointer(iptr13,ch8pte1(n))
652 pointer(iptr14,ch8pte2(m,n))
653 pointer(iptr15,ch8pte3(o,m,n))
655 type(drvd) dpte1
656 type(drvd) dpte2
657 type(drvd) dpte3
658 integer ipte1
659 integer ipte2
660 integer ipte3
661 real rpte1
662 real rpte2
663 real rpte3
664 character chpte1
665 character chpte2
666 character chpte3
667 character*8 ch8pte1
668 character*8 ch8pte2
669 character*8 ch8pte3
671 iptr1 = loc(dtarg1)
672 iptr2 = loc(dtarg2)
673 iptr3 = loc(dtarg3)
674 iptr4 = loc(itarg1)
675 iptr5 = loc(itarg2)
676 iptr6 = loc(itarg3)
677 iptr7 = loc(rtarg1)
678 iptr8 = loc(rtarg2)
679 iptr9 = loc(rtarg3)
680 iptr10= loc(chtarg1)
681 iptr11= loc(chtarg2)
682 iptr12= loc(chtarg3)
683 iptr13= loc(ch8targ1)
684 iptr14= loc(ch8targ2)
685 iptr15= loc(ch8targ3)
687 do, i=1,n
688 dpte1(i)%i1=i
689 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
690 ! Error #77
691 errors(77) = .true.
692 endif
694 dtarg1(i)%i1=2*dpte1(i)%i1
695 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
696 ! Error #78
697 errors(78) = .true.
698 endif
700 ipte1(i) = i
701 if (intne(ipte1(i), itarg1(i))) then
702 ! Error #79
703 errors(79) = .true.
704 endif
706 itarg1(i) = -ipte1(i)
707 if (intne(ipte1(i), itarg1(i))) then
708 ! Error #80
709 errors(80) = .true.
710 endif
712 rpte1(i) = i * 5.0
713 if (realne(rpte1(i), rtarg1(i))) then
714 ! Error #81
715 errors(81) = .true.
716 endif
718 rtarg1(i) = i * (-5.0)
719 if (realne(rpte1(i), rtarg1(i))) then
720 ! Error #82
721 errors(82) = .true.
722 endif
724 chpte1(i) = 'a'
725 if (chne(chpte1(i), chtarg1(i))) then
726 ! Error #83
727 errors(83) = .true.
728 endif
730 chtarg1(i) = 'z'
731 if (chne(chpte1(i), chtarg1(i))) then
732 ! Error #84
733 errors(84) = .true.
734 endif
736 ch8pte1(i) = 'aaaaaaaa'
737 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
738 ! Error #85
739 errors(85) = .true.
740 endif
742 ch8targ1(i) = 'zzzzzzzz'
743 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
744 ! Error #86
745 errors(86) = .true.
746 endif
748 do, j=1,m
749 dpte2(j,i)%r1=1.0
750 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
751 ! Error #87
752 errors(87) = .true.
753 endif
755 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
756 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
757 ! Error #88
758 errors(88) = .true.
759 endif
761 ipte2(j,i) = i
762 if (intne(ipte2(j,i), itarg2(j,i))) then
763 ! Error #89
764 errors(89) = .true.
765 endif
767 itarg2(j,i) = -ipte2(j,i)
768 if (intne(ipte2(j,i), itarg2(j,i))) then
769 ! Error #90
770 errors(90) = .true.
771 endif
773 rpte2(j,i) = i * (-2.0)
774 if (realne(rpte2(j,i), rtarg2(j,i))) then
775 ! Error #91
776 errors(91) = .true.
777 endif
779 rtarg2(j,i) = i * (-3.0)
780 if (realne(rpte2(j,i), rtarg2(j,i))) then
781 ! Error #92
782 errors(92) = .true.
783 endif
785 chpte2(j,i) = 'a'
786 if (chne(chpte2(j,i), chtarg2(j,i))) then
787 ! Error #93
788 errors(93) = .true.
789 endif
791 chtarg2(j,i) = 'z'
792 if (chne(chpte2(j,i), chtarg2(j,i))) then
793 ! Error #94
794 errors(94) = .true.
795 endif
797 ch8pte2(j,i) = 'aaaaaaaa'
798 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
799 ! Error #95
800 errors(95) = .true.
801 endif
803 ch8targ2(j,i) = 'zzzzzzzz'
804 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
805 ! Error #96
806 errors(96) = .true.
807 endif
808 do k=1,o
809 dpte3(k,j,i)%i2(1+mod(i,5))=i
810 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
811 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
812 ! Error #97
813 errors(97) = .true.
814 endif
816 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
817 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
818 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
819 ! Error #98
820 errors(98) = .true.
821 endif
823 ipte3(k,j,i) = i
824 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
825 ! Error #99
826 errors(99) = .true.
827 endif
829 itarg3(k,j,i) = -ipte3(k,j,i)
830 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
831 ! Error #100
832 errors(100) = .true.
833 endif
835 rpte3(k,j,i) = i * 2.0
836 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
837 ! Error #101
838 errors(101) = .true.
839 endif
841 rtarg3(k,j,i) = i * 3.0
842 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
843 ! Error #102
844 errors(102) = .true.
845 endif
847 chpte3(k,j,i) = 'a'
848 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
849 ! Error #103
850 errors(103) = .true.
851 endif
853 chtarg3(k,j,i) = 'z'
854 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
855 ! Error #104
856 errors(104) = .true.
857 endif
859 ch8pte3(k,j,i) = 'aaaaaaaa'
860 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
861 ! Error #105
862 errors(105) = .true.
863 endif
865 ch8targ3(k,j,i) = 'zzzzzzzz'
866 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
867 ! Error #106
868 errors(106) = .true.
869 endif
870 end do
871 end do
872 end do
874 rtarg3 = .5
875 ! Vector syntax
876 do, i=1,n
877 ipte3 = i
878 rpte3 = rpte3+1
879 do, j=1,m
880 do k=1,o
881 if (intne(itarg3(k,j,i), i)) then
882 ! Error #107
883 errors(107) = .true.
884 endif
886 if (realne(rtarg3(k,j,i), i+.5)) then
887 ! Error #108
888 errors(108) = .true.
889 endif
890 end do
891 end do
892 end do
893 end subroutine ptr3
895 subroutine ptr4
896 common /errors/errors(400)
897 logical :: errors, intne, realne, chne, ch8ne
898 integer :: i,j,k
899 integer, parameter :: n = 9
900 integer, parameter :: m = 10
901 integer, parameter :: o = 11
902 integer itarg1 (n)
903 integer itarg2 (m,n)
904 integer itarg3 (o,m,n)
905 real rtarg1(n)
906 real rtarg2(m,n)
907 real rtarg3(o,m,n)
908 character chtarg1(n)
909 character chtarg2(m,n)
910 character chtarg3(o,m,n)
911 character*8 ch8targ1(n)
912 character*8 ch8targ2(m,n)
913 character*8 ch8targ3(o,m,n)
914 type drvd
915 real r1
916 integer i1
917 integer i2(5)
918 end type drvd
919 type(drvd) dtarg1(n)
920 type(drvd) dtarg2(m,n)
921 type(drvd) dtarg3(o,m,n)
923 pointer(iptr1,dpte1),(iptr2,dpte2),(iptr3,dpte3)
924 pointer (iptr4,ipte1), (iptr5,ipte2) ,(iptr6,ipte3),(iptr7,rpte1)
925 pointer(iptr8,rpte2)
926 pointer(iptr9,rpte3),(iptr10,chpte1)
927 pointer(iptr11,chpte2),(iptr12,chpte3),(iptr13,ch8pte1)
928 pointer(iptr14,ch8pte2)
929 pointer(iptr15,ch8pte3)
931 type(drvd) dpte1(n)
932 type(drvd) dpte2(m,n)
933 type(drvd) dpte3(o,m,n)
934 integer ipte1 (n)
935 integer ipte2 (m,n)
936 integer ipte3 (o,m,n)
937 real rpte1(n)
938 real rpte2(m,n)
939 real rpte3(o,m,n)
940 character chpte1(n)
941 character chpte2(m,n)
942 character chpte3(o,m,n)
943 character*8 ch8pte1(n)
944 character*8 ch8pte2(m,n)
945 character*8 ch8pte3(o,m,n)
947 iptr1 = loc(dtarg1)
948 iptr2 = loc(dtarg2)
949 iptr3 = loc(dtarg3)
950 iptr4 = loc(itarg1)
951 iptr5 = loc(itarg2)
952 iptr6 = loc(itarg3)
953 iptr7 = loc(rtarg1)
954 iptr8 = loc(rtarg2)
955 iptr9 = loc(rtarg3)
956 iptr10= loc(chtarg1)
957 iptr11= loc(chtarg2)
958 iptr12= loc(chtarg3)
959 iptr13= loc(ch8targ1)
960 iptr14= loc(ch8targ2)
961 iptr15= loc(ch8targ3)
964 do, i=1,n
965 dpte1(i)%i1=i
966 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
967 ! Error #109
968 errors(109) = .true.
969 endif
971 dtarg1(i)%i1=2*dpte1(i)%i1
972 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
973 ! Error #110
974 errors(110) = .true.
975 endif
977 ipte1(i) = i
978 if (intne(ipte1(i), itarg1(i))) then
979 ! Error #111
980 errors(111) = .true.
981 endif
983 itarg1(i) = -ipte1(i)
984 if (intne(ipte1(i), itarg1(i))) then
985 ! Error #112
986 errors(112) = .true.
987 endif
989 rpte1(i) = i * 5.0
990 if (realne(rpte1(i), rtarg1(i))) then
991 ! Error #113
992 errors(113) = .true.
993 endif
995 rtarg1(i) = i * (-5.0)
996 if (realne(rpte1(i), rtarg1(i))) then
997 ! Error #114
998 errors(114) = .true.
999 endif
1001 chpte1(i) = 'a'
1002 if (chne(chpte1(i), chtarg1(i))) then
1003 ! Error #115
1004 errors(115) = .true.
1005 endif
1007 chtarg1(i) = 'z'
1008 if (chne(chpte1(i), chtarg1(i))) then
1009 ! Error #116
1010 errors(116) = .true.
1011 endif
1013 ch8pte1(i) = 'aaaaaaaa'
1014 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1015 ! Error #117
1016 errors(117) = .true.
1017 endif
1019 ch8targ1(i) = 'zzzzzzzz'
1020 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1021 ! Error #118
1022 errors(118) = .true.
1023 endif
1025 do, j=1,m
1026 dpte2(j,i)%r1=1.0
1027 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
1028 ! Error #119
1029 errors(119) = .true.
1030 endif
1032 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
1033 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
1034 ! Error #120
1035 errors(120) = .true.
1036 endif
1038 ipte2(j,i) = i
1039 if (intne(ipte2(j,i), itarg2(j,i))) then
1040 ! Error #121
1041 errors(121) = .true.
1042 endif
1044 itarg2(j,i) = -ipte2(j,i)
1045 if (intne(ipte2(j,i), itarg2(j,i))) then
1046 ! Error #122
1047 errors(122) = .true.
1048 endif
1050 rpte2(j,i) = i * (-2.0)
1051 if (realne(rpte2(j,i), rtarg2(j,i))) then
1052 ! Error #123
1053 errors(123) = .true.
1054 endif
1056 rtarg2(j,i) = i * (-3.0)
1057 if (realne(rpte2(j,i), rtarg2(j,i))) then
1058 ! Error #124
1059 errors(124) = .true.
1060 endif
1062 chpte2(j,i) = 'a'
1063 if (chne(chpte2(j,i), chtarg2(j,i))) then
1064 ! Error #125
1065 errors(125) = .true.
1066 endif
1068 chtarg2(j,i) = 'z'
1069 if (chne(chpte2(j,i), chtarg2(j,i))) then
1070 ! Error #126
1071 errors(126) = .true.
1072 endif
1074 ch8pte2(j,i) = 'aaaaaaaa'
1075 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1076 ! Error #127
1077 errors(127) = .true.
1078 endif
1080 ch8targ2(j,i) = 'zzzzzzzz'
1081 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1082 ! Error #128
1083 errors(128) = .true.
1084 endif
1085 do k=1,o
1086 dpte3(k,j,i)%i2(1+mod(i,5))=i
1087 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
1088 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
1089 ! Error #129
1090 errors(129) = .true.
1091 endif
1093 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
1094 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
1095 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
1096 ! Error #130
1097 errors(130) = .true.
1098 endif
1100 ipte3(k,j,i) = i
1101 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
1102 ! Error #131
1103 errors(131) = .true.
1104 endif
1106 itarg3(k,j,i) = -ipte3(k,j,i)
1107 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
1108 ! Error #132
1109 errors(132) = .true.
1110 endif
1112 rpte3(k,j,i) = i * 2.0
1113 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
1114 ! Error #133
1115 errors(133) = .true.
1116 endif
1118 rtarg3(k,j,i) = i * 3.0
1119 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
1120 ! Error #134
1121 errors(134) = .true.
1122 endif
1124 chpte3(k,j,i) = 'a'
1125 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
1126 ! Error #135
1127 errors(135) = .true.
1128 endif
1130 chtarg3(k,j,i) = 'z'
1131 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
1132 ! Error #136
1133 errors(136) = .true.
1134 endif
1136 ch8pte3(k,j,i) = 'aaaaaaaa'
1137 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
1138 ! Error #137
1139 errors(137) = .true.
1140 endif
1142 ch8targ3(k,j,i) = 'zzzzzzzz'
1143 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
1144 ! Error #138
1145 errors(138) = .true.
1146 endif
1147 end do
1148 end do
1149 end do
1151 rtarg3 = .5
1152 ! Vector syntax
1153 do, i=1,n
1154 ipte3 = i
1155 rpte3 = rpte3+1
1156 do, j=1,m
1157 do k=1,o
1158 if (intne(itarg3(k,j,i), i)) then
1159 ! Error #139
1160 errors(139) = .true.
1161 endif
1163 if (realne(rtarg3(k,j,i), i+.5)) then
1164 ! Error #140
1165 errors(140) = .true.
1166 endif
1167 end do
1168 end do
1169 end do
1171 end subroutine ptr4
1173 subroutine ptr5
1174 common /errors/errors(400)
1175 logical :: errors, intne, realne, chne, ch8ne
1176 integer :: i,j,k
1177 integer, parameter :: n = 9
1178 integer, parameter :: m = 10
1179 integer, parameter :: o = 11
1180 integer itarg1 (n)
1181 integer itarg2 (m,n)
1182 integer itarg3 (o,m,n)
1183 real rtarg1(n)
1184 real rtarg2(m,n)
1185 real rtarg3(o,m,n)
1186 character chtarg1(n)
1187 character chtarg2(m,n)
1188 character chtarg3(o,m,n)
1189 character*8 ch8targ1(n)
1190 character*8 ch8targ2(m,n)
1191 character*8 ch8targ3(o,m,n)
1192 type drvd
1193 real r1
1194 integer i1
1195 integer i2(5)
1196 end type drvd
1197 type(drvd) dtarg1(n)
1198 type(drvd) dtarg2(m,n)
1199 type(drvd) dtarg3(o,m,n)
1201 type(drvd) dpte1(*)
1202 type(drvd) dpte2(m,*)
1203 type(drvd) dpte3(o,m,*)
1204 integer ipte1 (*)
1205 integer ipte2 (m,*)
1206 integer ipte3 (o,m,*)
1207 real rpte1(*)
1208 real rpte2(m,*)
1209 real rpte3(o,m,*)
1210 character chpte1(*)
1211 character chpte2(m,*)
1212 character chpte3(o,m,*)
1213 character*8 ch8pte1(*)
1214 character*8 ch8pte2(m,*)
1215 character*8 ch8pte3(o,m,*)
1217 pointer(iptr1,dpte1)
1218 pointer(iptr2,dpte2)
1219 pointer(iptr3,dpte3)
1220 pointer(iptr4,ipte1)
1221 pointer(iptr5,ipte2)
1222 pointer(iptr6,ipte3)
1223 pointer(iptr7,rpte1)
1224 pointer(iptr8,rpte2)
1225 pointer(iptr9,rpte3)
1226 pointer(iptr10,chpte1)
1227 pointer(iptr11,chpte2)
1228 pointer(iptr12,chpte3)
1229 pointer(iptr13,ch8pte1)
1230 pointer(iptr14,ch8pte2)
1231 pointer(iptr15,ch8pte3)
1233 iptr1 = loc(dtarg1)
1234 iptr2 = loc(dtarg2)
1235 iptr3 = loc(dtarg3)
1236 iptr4 = loc(itarg1)
1237 iptr5 = loc(itarg2)
1238 iptr6 = loc(itarg3)
1239 iptr7 = loc(rtarg1)
1240 iptr8 = loc(rtarg2)
1241 iptr9 = loc(rtarg3)
1242 iptr10= loc(chtarg1)
1243 iptr11= loc(chtarg2)
1244 iptr12= loc(chtarg3)
1245 iptr13= loc(ch8targ1)
1246 iptr14= loc(ch8targ2)
1247 iptr15= loc(ch8targ3)
1250 do, i=1,n
1251 dpte1(i)%i1=i
1252 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
1253 ! Error #141
1254 errors(141) = .true.
1255 endif
1257 dtarg1(i)%i1=2*dpte1(i)%i1
1258 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
1259 ! Error #142
1260 errors(142) = .true.
1261 endif
1263 ipte1(i) = i
1264 if (intne(ipte1(i), itarg1(i))) then
1265 ! Error #143
1266 errors(143) = .true.
1267 endif
1269 itarg1(i) = -ipte1(i)
1270 if (intne(ipte1(i), itarg1(i))) then
1271 ! Error #144
1272 errors(144) = .true.
1273 endif
1275 rpte1(i) = i * 5.0
1276 if (realne(rpte1(i), rtarg1(i))) then
1277 ! Error #145
1278 errors(145) = .true.
1279 endif
1281 rtarg1(i) = i * (-5.0)
1282 if (realne(rpte1(i), rtarg1(i))) then
1283 ! Error #146
1284 errors(146) = .true.
1285 endif
1287 chpte1(i) = 'a'
1288 if (chne(chpte1(i), chtarg1(i))) then
1289 ! Error #147
1290 errors(147) = .true.
1291 endif
1293 chtarg1(i) = 'z'
1294 if (chne(chpte1(i), chtarg1(i))) then
1295 ! Error #148
1296 errors(148) = .true.
1297 endif
1299 ch8pte1(i) = 'aaaaaaaa'
1300 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1301 ! Error #149
1302 errors(149) = .true.
1303 endif
1305 ch8targ1(i) = 'zzzzzzzz'
1306 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1307 ! Error #150
1308 errors(150) = .true.
1309 endif
1311 do, j=1,m
1312 dpte2(j,i)%r1=1.0
1313 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
1314 ! Error #151
1315 errors(151) = .true.
1316 endif
1318 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
1319 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
1320 ! Error #152
1321 errors(152) = .true.
1322 endif
1324 ipte2(j,i) = i
1325 if (intne(ipte2(j,i), itarg2(j,i))) then
1326 ! Error #153
1327 errors(153) = .true.
1328 endif
1330 itarg2(j,i) = -ipte2(j,i)
1331 if (intne(ipte2(j,i), itarg2(j,i))) then
1332 ! Error #154
1333 errors(154) = .true.
1334 endif
1336 rpte2(j,i) = i * (-2.0)
1337 if (realne(rpte2(j,i), rtarg2(j,i))) then
1338 ! Error #155
1339 errors(155) = .true.
1340 endif
1342 rtarg2(j,i) = i * (-3.0)
1343 if (realne(rpte2(j,i), rtarg2(j,i))) then
1344 ! Error #156
1345 errors(156) = .true.
1346 endif
1348 chpte2(j,i) = 'a'
1349 if (chne(chpte2(j,i), chtarg2(j,i))) then
1350 ! Error #157
1351 errors(157) = .true.
1352 endif
1354 chtarg2(j,i) = 'z'
1355 if (chne(chpte2(j,i), chtarg2(j,i))) then
1356 ! Error #158
1357 errors(158) = .true.
1358 endif
1360 ch8pte2(j,i) = 'aaaaaaaa'
1361 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1362 ! Error #159
1363 errors(159) = .true.
1364 endif
1366 ch8targ2(j,i) = 'zzzzzzzz'
1367 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1368 ! Error #160
1369 errors(160) = .true.
1370 endif
1371 do k=1,o
1372 dpte3(k,j,i)%i2(1+mod(i,5))=i
1373 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
1374 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
1375 ! Error #161
1376 errors(161) = .true.
1377 endif
1379 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
1380 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
1381 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
1382 ! Error #162
1383 errors(162) = .true.
1384 endif
1386 ipte3(k,j,i) = i
1387 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
1388 ! Error #163
1389 errors(163) = .true.
1390 endif
1392 itarg3(k,j,i) = -ipte3(k,j,i)
1393 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
1394 ! Error #164
1395 errors(164) = .true.
1396 endif
1398 rpte3(k,j,i) = i * 2.0
1399 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
1400 ! Error #165
1401 errors(165) = .true.
1402 endif
1404 rtarg3(k,j,i) = i * 3.0
1405 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
1406 ! Error #166
1407 errors(166) = .true.
1408 endif
1410 chpte3(k,j,i) = 'a'
1411 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
1412 ! Error #167
1413 errors(167) = .true.
1414 endif
1416 chtarg3(k,j,i) = 'z'
1417 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
1418 ! Error #168
1419 errors(168) = .true.
1420 endif
1422 ch8pte3(k,j,i) = 'aaaaaaaa'
1423 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
1424 ! Error #169
1425 errors(169) = .true.
1426 endif
1428 ch8targ3(k,j,i) = 'zzzzzzzz'
1429 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
1430 ! Error #170
1431 errors(170) = .true.
1432 endif
1433 end do
1434 end do
1435 end do
1437 end subroutine ptr5
1440 subroutine ptr6
1441 common /errors/errors(400)
1442 logical :: errors, intne, realne, chne, ch8ne
1443 integer :: i,j,k
1444 integer, parameter :: n = 9
1445 integer, parameter :: m = 10
1446 integer, parameter :: o = 11
1447 integer itarg1 (n)
1448 integer itarg2 (m,n)
1449 integer itarg3 (o,m,n)
1450 real rtarg1(n)
1451 real rtarg2(m,n)
1452 real rtarg3(o,m,n)
1453 character chtarg1(n)
1454 character chtarg2(m,n)
1455 character chtarg3(o,m,n)
1456 character*8 ch8targ1(n)
1457 character*8 ch8targ2(m,n)
1458 character*8 ch8targ3(o,m,n)
1459 type drvd
1460 real r1
1461 integer i1
1462 integer i2(5)
1463 end type drvd
1464 type(drvd) dtarg1(n)
1465 type(drvd) dtarg2(m,n)
1466 type(drvd) dtarg3(o,m,n)
1468 type(drvd) dpte1
1469 type(drvd) dpte2
1470 type(drvd) dpte3
1471 integer ipte1
1472 integer ipte2
1473 integer ipte3
1474 real rpte1
1475 real rpte2
1476 real rpte3
1477 character chpte1
1478 character chpte2
1479 character chpte3
1480 character*8 ch8pte1
1481 character*8 ch8pte2
1482 character*8 ch8pte3
1484 pointer(iptr1,dpte1(*))
1485 pointer(iptr2,dpte2(m,*))
1486 pointer(iptr3,dpte3(o,m,*))
1487 pointer(iptr4,ipte1(*))
1488 pointer(iptr5,ipte2 (m,*))
1489 pointer(iptr6,ipte3(o,m,*))
1490 pointer(iptr7,rpte1(*))
1491 pointer(iptr8,rpte2(m,*))
1492 pointer(iptr9,rpte3(o,m,*))
1493 pointer(iptr10,chpte1(*))
1494 pointer(iptr11,chpte2(m,*))
1495 pointer(iptr12,chpte3(o,m,*))
1496 pointer(iptr13,ch8pte1(*))
1497 pointer(iptr14,ch8pte2(m,*))
1498 pointer(iptr15,ch8pte3(o,m,*))
1500 iptr1 = loc(dtarg1)
1501 iptr2 = loc(dtarg2)
1502 iptr3 = loc(dtarg3)
1503 iptr4 = loc(itarg1)
1504 iptr5 = loc(itarg2)
1505 iptr6 = loc(itarg3)
1506 iptr7 = loc(rtarg1)
1507 iptr8 = loc(rtarg2)
1508 iptr9 = loc(rtarg3)
1509 iptr10= loc(chtarg1)
1510 iptr11= loc(chtarg2)
1511 iptr12= loc(chtarg3)
1512 iptr13= loc(ch8targ1)
1513 iptr14= loc(ch8targ2)
1514 iptr15= loc(ch8targ3)
1516 do, i=1,n
1517 dpte1(i)%i1=i
1518 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
1519 ! Error #171
1520 errors(171) = .true.
1521 endif
1523 dtarg1(i)%i1=2*dpte1(i)%i1
1524 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
1525 ! Error #172
1526 errors(172) = .true.
1527 endif
1529 ipte1(i) = i
1530 if (intne(ipte1(i), itarg1(i))) then
1531 ! Error #173
1532 errors(173) = .true.
1533 endif
1535 itarg1(i) = -ipte1(i)
1536 if (intne(ipte1(i), itarg1(i))) then
1537 ! Error #174
1538 errors(174) = .true.
1539 endif
1541 rpte1(i) = i * 5.0
1542 if (realne(rpte1(i), rtarg1(i))) then
1543 ! Error #175
1544 errors(175) = .true.
1545 endif
1547 rtarg1(i) = i * (-5.0)
1548 if (realne(rpte1(i), rtarg1(i))) then
1549 ! Error #176
1550 errors(176) = .true.
1551 endif
1553 chpte1(i) = 'a'
1554 if (chne(chpte1(i), chtarg1(i))) then
1555 ! Error #177
1556 errors(177) = .true.
1557 endif
1559 chtarg1(i) = 'z'
1560 if (chne(chpte1(i), chtarg1(i))) then
1561 ! Error #178
1562 errors(178) = .true.
1563 endif
1565 ch8pte1(i) = 'aaaaaaaa'
1566 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1567 ! Error #179
1568 errors(179) = .true.
1569 endif
1571 ch8targ1(i) = 'zzzzzzzz'
1572 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1573 ! Error #180
1574 errors(180) = .true.
1575 endif
1577 do, j=1,m
1578 dpte2(j,i)%r1=1.0
1579 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
1580 ! Error #181
1581 errors(181) = .true.
1582 endif
1584 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
1585 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
1586 ! Error #182
1587 errors(182) = .true.
1588 endif
1590 ipte2(j,i) = i
1591 if (intne(ipte2(j,i), itarg2(j,i))) then
1592 ! Error #183
1593 errors(183) = .true.
1594 endif
1596 itarg2(j,i) = -ipte2(j,i)
1597 if (intne(ipte2(j,i), itarg2(j,i))) then
1598 ! Error #184
1599 errors(184) = .true.
1600 endif
1602 rpte2(j,i) = i * (-2.0)
1603 if (realne(rpte2(j,i), rtarg2(j,i))) then
1604 ! Error #185
1605 errors(185) = .true.
1606 endif
1608 rtarg2(j,i) = i * (-3.0)
1609 if (realne(rpte2(j,i), rtarg2(j,i))) then
1610 ! Error #186
1611 errors(186) = .true.
1612 endif
1614 chpte2(j,i) = 'a'
1615 if (chne(chpte2(j,i), chtarg2(j,i))) then
1616 ! Error #187
1617 errors(187) = .true.
1618 endif
1620 chtarg2(j,i) = 'z'
1621 if (chne(chpte2(j,i), chtarg2(j,i))) then
1622 ! Error #188
1623 errors(188) = .true.
1624 endif
1626 ch8pte2(j,i) = 'aaaaaaaa'
1627 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1628 ! Error #189
1629 errors(189) = .true.
1630 endif
1632 ch8targ2(j,i) = 'zzzzzzzz'
1633 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1634 ! Error #190
1635 errors(190) = .true.
1636 endif
1637 do k=1,o
1638 dpte3(k,j,i)%i2(1+mod(i,5))=i
1639 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
1640 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
1641 ! Error #191
1642 errors(191) = .true.
1643 endif
1645 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
1646 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
1647 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
1648 ! Error #192
1649 errors(192) = .true.
1650 endif
1652 ipte3(k,j,i) = i
1653 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
1654 ! Error #193
1655 errors(193) = .true.
1656 endif
1658 itarg3(k,j,i) = -ipte3(k,j,i)
1659 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
1660 ! Error #194
1661 errors(194) = .true.
1662 endif
1664 rpte3(k,j,i) = i * 2.0
1665 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
1666 ! Error #195
1667 errors(195) = .true.
1668 endif
1670 rtarg3(k,j,i) = i * 3.0
1671 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
1672 ! Error #196
1673 errors(196) = .true.
1674 endif
1676 chpte3(k,j,i) = 'a'
1677 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
1678 ! Error #197
1679 errors(197) = .true.
1680 endif
1682 chtarg3(k,j,i) = 'z'
1683 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
1684 ! Error #198
1685 errors(198) = .true.
1686 endif
1688 ch8pte3(k,j,i) = 'aaaaaaaa'
1689 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
1690 ! Error #199
1691 errors(199) = .true.
1692 endif
1694 ch8targ3(k,j,i) = 'zzzzzzzz'
1695 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
1696 ! Error #200
1697 errors(200) = .true.
1698 endif
1699 end do
1700 end do
1701 end do
1703 end subroutine ptr6
1705 subroutine ptr7
1706 common /errors/errors(400)
1707 logical :: errors, intne, realne, chne, ch8ne
1708 integer :: i,j,k
1709 integer, parameter :: n = 9
1710 integer, parameter :: m = 10
1711 integer, parameter :: o = 11
1712 integer itarg1 (n)
1713 integer itarg2 (m,n)
1714 integer itarg3 (o,m,n)
1715 real rtarg1(n)
1716 real rtarg2(m,n)
1717 real rtarg3(o,m,n)
1718 character chtarg1(n)
1719 character chtarg2(m,n)
1720 character chtarg3(o,m,n)
1721 character*8 ch8targ1(n)
1722 character*8 ch8targ2(m,n)
1723 character*8 ch8targ3(o,m,n)
1724 type drvd
1725 real r1
1726 integer i1
1727 integer i2(5)
1728 end type drvd
1729 type(drvd) dtarg1(n)
1730 type(drvd) dtarg2(m,n)
1731 type(drvd) dtarg3(o,m,n)
1733 pointer(iptr1,dpte1(*))
1734 pointer(iptr2,dpte2(m,*))
1735 pointer(iptr3,dpte3(o,m,*))
1736 pointer(iptr4,ipte1(*))
1737 pointer(iptr5,ipte2 (m,*))
1738 pointer(iptr6,ipte3(o,m,*))
1739 pointer(iptr7,rpte1(*))
1740 pointer(iptr8,rpte2(m,*))
1741 pointer(iptr9,rpte3(o,m,*))
1742 pointer(iptr10,chpte1(*))
1743 pointer(iptr11,chpte2(m,*))
1744 pointer(iptr12,chpte3(o,m,*))
1745 pointer(iptr13,ch8pte1(*))
1746 pointer(iptr14,ch8pte2(m,*))
1747 pointer(iptr15,ch8pte3(o,m,*))
1749 type(drvd) dpte1
1750 type(drvd) dpte2
1751 type(drvd) dpte3
1752 integer ipte1
1753 integer ipte2
1754 integer ipte3
1755 real rpte1
1756 real rpte2
1757 real rpte3
1758 character chpte1
1759 character chpte2
1760 character chpte3
1761 character*8 ch8pte1
1762 character*8 ch8pte2
1763 character*8 ch8pte3
1765 iptr1 = loc(dtarg1)
1766 iptr2 = loc(dtarg2)
1767 iptr3 = loc(dtarg3)
1768 iptr4 = loc(itarg1)
1769 iptr5 = loc(itarg2)
1770 iptr6 = loc(itarg3)
1771 iptr7 = loc(rtarg1)
1772 iptr8 = loc(rtarg2)
1773 iptr9 = loc(rtarg3)
1774 iptr10= loc(chtarg1)
1775 iptr11= loc(chtarg2)
1776 iptr12= loc(chtarg3)
1777 iptr13= loc(ch8targ1)
1778 iptr14= loc(ch8targ2)
1779 iptr15= loc(ch8targ3)
1781 do, i=1,n
1782 dpte1(i)%i1=i
1783 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
1784 ! Error #201
1785 errors(201) = .true.
1786 endif
1788 dtarg1(i)%i1=2*dpte1(i)%i1
1789 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
1790 ! Error #202
1791 errors(202) = .true.
1792 endif
1794 ipte1(i) = i
1795 if (intne(ipte1(i), itarg1(i))) then
1796 ! Error #203
1797 errors(203) = .true.
1798 endif
1800 itarg1(i) = -ipte1(i)
1801 if (intne(ipte1(i), itarg1(i))) then
1802 ! Error #204
1803 errors(204) = .true.
1804 endif
1806 rpte1(i) = i * 5.0
1807 if (realne(rpte1(i), rtarg1(i))) then
1808 ! Error #205
1809 errors(205) = .true.
1810 endif
1812 rtarg1(i) = i * (-5.0)
1813 if (realne(rpte1(i), rtarg1(i))) then
1814 ! Error #206
1815 errors(206) = .true.
1816 endif
1818 chpte1(i) = 'a'
1819 if (chne(chpte1(i), chtarg1(i))) then
1820 ! Error #207
1821 errors(207) = .true.
1822 endif
1824 chtarg1(i) = 'z'
1825 if (chne(chpte1(i), chtarg1(i))) then
1826 ! Error #208
1827 errors(208) = .true.
1828 endif
1830 ch8pte1(i) = 'aaaaaaaa'
1831 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1832 ! Error #209
1833 errors(209) = .true.
1834 endif
1836 ch8targ1(i) = 'zzzzzzzz'
1837 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1838 ! Error #210
1839 errors(210) = .true.
1840 endif
1842 do, j=1,m
1843 dpte2(j,i)%r1=1.0
1844 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
1845 ! Error #211
1846 errors(211) = .true.
1847 endif
1849 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
1850 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
1851 ! Error #212
1852 errors(212) = .true.
1853 endif
1855 ipte2(j,i) = i
1856 if (intne(ipte2(j,i), itarg2(j,i))) then
1857 ! Error #213
1858 errors(213) = .true.
1859 endif
1861 itarg2(j,i) = -ipte2(j,i)
1862 if (intne(ipte2(j,i), itarg2(j,i))) then
1863 ! Error #214
1864 errors(214) = .true.
1865 endif
1867 rpte2(j,i) = i * (-2.0)
1868 if (realne(rpte2(j,i), rtarg2(j,i))) then
1869 ! Error #215
1870 errors(215) = .true.
1871 endif
1873 rtarg2(j,i) = i * (-3.0)
1874 if (realne(rpte2(j,i), rtarg2(j,i))) then
1875 ! Error #216
1876 errors(216) = .true.
1877 endif
1879 chpte2(j,i) = 'a'
1880 if (chne(chpte2(j,i), chtarg2(j,i))) then
1881 ! Error #217
1882 errors(217) = .true.
1883 endif
1885 chtarg2(j,i) = 'z'
1886 if (chne(chpte2(j,i), chtarg2(j,i))) then
1887 ! Error #218
1888 errors(218) = .true.
1889 endif
1891 ch8pte2(j,i) = 'aaaaaaaa'
1892 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1893 ! Error #219
1894 errors(219) = .true.
1895 endif
1897 ch8targ2(j,i) = 'zzzzzzzz'
1898 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1899 ! Error #220
1900 errors(220) = .true.
1901 endif
1902 do k=1,o
1903 dpte3(k,j,i)%i2(1+mod(i,5))=i
1904 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
1905 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
1906 ! Error #221
1907 errors(221) = .true.
1908 endif
1910 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
1911 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
1912 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
1913 ! Error #222
1914 errors(222) = .true.
1915 endif
1917 ipte3(k,j,i) = i
1918 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
1919 ! Error #223
1920 errors(223) = .true.
1921 endif
1923 itarg3(k,j,i) = -ipte3(k,j,i)
1924 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
1925 ! Error #224
1926 errors(224) = .true.
1927 endif
1929 rpte3(k,j,i) = i * 2.0
1930 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
1931 ! Error #225
1932 errors(225) = .true.
1933 endif
1935 rtarg3(k,j,i) = i * 3.0
1936 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
1937 ! Error #226
1938 errors(226) = .true.
1939 endif
1941 chpte3(k,j,i) = 'a'
1942 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
1943 ! Error #227
1944 errors(227) = .true.
1945 endif
1947 chtarg3(k,j,i) = 'z'
1948 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
1949 ! Error #228
1950 errors(228) = .true.
1951 endif
1953 ch8pte3(k,j,i) = 'aaaaaaaa'
1954 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
1955 ! Error #229
1956 errors(229) = .true.
1957 endif
1959 ch8targ3(k,j,i) = 'zzzzzzzz'
1960 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
1961 ! Error #230
1962 errors(230) = .true.
1963 endif
1964 end do
1965 end do
1966 end do
1968 end subroutine ptr7
1970 subroutine ptr8
1971 common /errors/errors(400)
1972 logical :: errors, intne, realne, chne, ch8ne
1973 integer :: i,j,k
1974 integer, parameter :: n = 9
1975 integer, parameter :: m = 10
1976 integer, parameter :: o = 11
1977 integer itarg1 (n)
1978 integer itarg2 (m,n)
1979 integer itarg3 (o,m,n)
1980 real rtarg1(n)
1981 real rtarg2(m,n)
1982 real rtarg3(o,m,n)
1983 character chtarg1(n)
1984 character chtarg2(m,n)
1985 character chtarg3(o,m,n)
1986 character*8 ch8targ1(n)
1987 character*8 ch8targ2(m,n)
1988 character*8 ch8targ3(o,m,n)
1989 type drvd
1990 real r1
1991 integer i1
1992 integer i2(5)
1993 end type drvd
1994 type(drvd) dtarg1(n)
1995 type(drvd) dtarg2(m,n)
1996 type(drvd) dtarg3(o,m,n)
1998 pointer(iptr1,dpte1)
1999 pointer(iptr2,dpte2)
2000 pointer(iptr3,dpte3)
2001 pointer(iptr4,ipte1)
2002 pointer(iptr5,ipte2)
2003 pointer(iptr6,ipte3)
2004 pointer(iptr7,rpte1)
2005 pointer(iptr8,rpte2)
2006 pointer(iptr9,rpte3)
2007 pointer(iptr10,chpte1)
2008 pointer(iptr11,chpte2)
2009 pointer(iptr12,chpte3)
2010 pointer(iptr13,ch8pte1)
2011 pointer(iptr14,ch8pte2)
2012 pointer(iptr15,ch8pte3)
2014 type(drvd) dpte1(*)
2015 type(drvd) dpte2(m,*)
2016 type(drvd) dpte3(o,m,*)
2017 integer ipte1 (*)
2018 integer ipte2 (m,*)
2019 integer ipte3 (o,m,*)
2020 real rpte1(*)
2021 real rpte2(m,*)
2022 real rpte3(o,m,*)
2023 character chpte1(*)
2024 character chpte2(m,*)
2025 character chpte3(o,m,*)
2026 character*8 ch8pte1(*)
2027 character*8 ch8pte2(m,*)
2028 character*8 ch8pte3(o,m,*)
2030 iptr1 = loc(dtarg1)
2031 iptr2 = loc(dtarg2)
2032 iptr3 = loc(dtarg3)
2033 iptr4 = loc(itarg1)
2034 iptr5 = loc(itarg2)
2035 iptr6 = loc(itarg3)
2036 iptr7 = loc(rtarg1)
2037 iptr8 = loc(rtarg2)
2038 iptr9 = loc(rtarg3)
2039 iptr10= loc(chtarg1)
2040 iptr11= loc(chtarg2)
2041 iptr12= loc(chtarg3)
2042 iptr13= loc(ch8targ1)
2043 iptr14= loc(ch8targ2)
2044 iptr15= loc(ch8targ3)
2047 do, i=1,n
2048 dpte1(i)%i1=i
2049 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
2050 ! Error #231
2051 errors(231) = .true.
2052 endif
2054 dtarg1(i)%i1=2*dpte1(i)%i1
2055 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
2056 ! Error #232
2057 errors(232) = .true.
2058 endif
2060 ipte1(i) = i
2061 if (intne(ipte1(i), itarg1(i))) then
2062 ! Error #233
2063 errors(233) = .true.
2064 endif
2066 itarg1(i) = -ipte1(i)
2067 if (intne(ipte1(i), itarg1(i))) then
2068 ! Error #234
2069 errors(234) = .true.
2070 endif
2072 rpte1(i) = i * 5.0
2073 if (realne(rpte1(i), rtarg1(i))) then
2074 ! Error #235
2075 errors(235) = .true.
2076 endif
2078 rtarg1(i) = i * (-5.0)
2079 if (realne(rpte1(i), rtarg1(i))) then
2080 ! Error #236
2081 errors(236) = .true.
2082 endif
2084 chpte1(i) = 'a'
2085 if (chne(chpte1(i), chtarg1(i))) then
2086 ! Error #237
2087 errors(237) = .true.
2088 endif
2090 chtarg1(i) = 'z'
2091 if (chne(chpte1(i), chtarg1(i))) then
2092 ! Error #238
2093 errors(238) = .true.
2094 endif
2096 ch8pte1(i) = 'aaaaaaaa'
2097 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2098 ! Error #239
2099 errors(239) = .true.
2100 endif
2102 ch8targ1(i) = 'zzzzzzzz'
2103 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2104 ! Error #240
2105 errors(240) = .true.
2106 endif
2108 do, j=1,m
2109 dpte2(j,i)%r1=1.0
2110 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
2111 ! Error #241
2112 errors(241) = .true.
2113 endif
2115 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
2116 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
2117 ! Error #242
2118 errors(242) = .true.
2119 endif
2121 ipte2(j,i) = i
2122 if (intne(ipte2(j,i), itarg2(j,i))) then
2123 ! Error #243
2124 errors(243) = .true.
2125 endif
2127 itarg2(j,i) = -ipte2(j,i)
2128 if (intne(ipte2(j,i), itarg2(j,i))) then
2129 ! Error #244
2130 errors(244) = .true.
2131 endif
2133 rpte2(j,i) = i * (-2.0)
2134 if (realne(rpte2(j,i), rtarg2(j,i))) then
2135 ! Error #245
2136 errors(245) = .true.
2137 endif
2139 rtarg2(j,i) = i * (-3.0)
2140 if (realne(rpte2(j,i), rtarg2(j,i))) then
2141 ! Error #246
2142 errors(246) = .true.
2143 endif
2145 chpte2(j,i) = 'a'
2146 if (chne(chpte2(j,i), chtarg2(j,i))) then
2147 ! Error #247
2148 errors(247) = .true.
2149 endif
2151 chtarg2(j,i) = 'z'
2152 if (chne(chpte2(j,i), chtarg2(j,i))) then
2153 ! Error #248
2154 errors(248) = .true.
2155 endif
2157 ch8pte2(j,i) = 'aaaaaaaa'
2158 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
2159 ! Error #249
2160 errors(249) = .true.
2161 endif
2163 ch8targ2(j,i) = 'zzzzzzzz'
2164 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
2165 ! Error #250
2166 errors(250) = .true.
2167 endif
2168 do k=1,o
2169 dpte3(k,j,i)%i2(1+mod(i,5))=i
2170 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
2171 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
2172 ! Error #251
2173 errors(251) = .true.
2174 endif
2176 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
2177 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
2178 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
2179 ! Error #252
2180 errors(252) = .true.
2181 endif
2183 ipte3(k,j,i) = i
2184 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
2185 ! Error #253
2186 errors(253) = .true.
2187 endif
2189 itarg3(k,j,i) = -ipte3(k,j,i)
2190 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
2191 ! Error #254
2192 errors(254) = .true.
2193 endif
2195 rpte3(k,j,i) = i * 2.0
2196 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
2197 ! Error #255
2198 errors(255) = .true.
2199 endif
2201 rtarg3(k,j,i) = i * 3.0
2202 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
2203 ! Error #256
2204 errors(256) = .true.
2205 endif
2207 chpte3(k,j,i) = 'a'
2208 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
2209 ! Error #257
2210 errors(257) = .true.
2211 endif
2213 chtarg3(k,j,i) = 'z'
2214 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
2215 ! Error #258
2216 errors(258) = .true.
2217 endif
2219 ch8pte3(k,j,i) = 'aaaaaaaa'
2220 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
2221 ! Error #259
2222 errors(259) = .true.
2223 endif
2225 ch8targ3(k,j,i) = 'zzzzzzzz'
2226 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
2227 ! Error #260
2228 errors(260) = .true.
2229 endif
2230 end do
2231 end do
2232 end do
2233 end subroutine ptr8
2236 subroutine ptr9(nnn,mmm,ooo)
2237 common /errors/errors(400)
2238 logical :: errors, intne, realne, chne, ch8ne
2239 integer :: i,j,k
2240 integer :: nnn,mmm,ooo
2241 integer, parameter :: n = 9
2242 integer, parameter :: m = 10
2243 integer, parameter :: o = 11
2244 integer itarg1 (n)
2245 integer itarg2 (m,n)
2246 integer itarg3 (o,m,n)
2247 real rtarg1(n)
2248 real rtarg2(m,n)
2249 real rtarg3(o,m,n)
2250 character chtarg1(n)
2251 character chtarg2(m,n)
2252 character chtarg3(o,m,n)
2253 character*8 ch8targ1(n)
2254 character*8 ch8targ2(m,n)
2255 character*8 ch8targ3(o,m,n)
2256 type drvd
2257 real r1
2258 integer i1
2259 integer i2(5)
2260 end type drvd
2261 type(drvd) dtarg1(n)
2262 type(drvd) dtarg2(m,n)
2263 type(drvd) dtarg3(o,m,n)
2265 type(drvd) dpte1(nnn)
2266 type(drvd) dpte2(mmm,nnn)
2267 type(drvd) dpte3(ooo,mmm,nnn)
2268 integer ipte1 (nnn)
2269 integer ipte2 (mmm,nnn)
2270 integer ipte3 (ooo,mmm,nnn)
2271 real rpte1(nnn)
2272 real rpte2(mmm,nnn)
2273 real rpte3(ooo,mmm,nnn)
2274 character chpte1(nnn)
2275 character chpte2(mmm,nnn)
2276 character chpte3(ooo,mmm,nnn)
2277 character*8 ch8pte1(nnn)
2278 character*8 ch8pte2(mmm,nnn)
2279 character*8 ch8pte3(ooo,mmm,nnn)
2281 pointer(iptr1,dpte1)
2282 pointer(iptr2,dpte2)
2283 pointer(iptr3,dpte3)
2284 pointer(iptr4,ipte1)
2285 pointer(iptr5,ipte2)
2286 pointer(iptr6,ipte3)
2287 pointer(iptr7,rpte1)
2288 pointer(iptr8,rpte2)
2289 pointer(iptr9,rpte3)
2290 pointer(iptr10,chpte1)
2291 pointer(iptr11,chpte2)
2292 pointer(iptr12,chpte3)
2293 pointer(iptr13,ch8pte1)
2294 pointer(iptr14,ch8pte2)
2295 pointer(iptr15,ch8pte3)
2297 iptr1 = loc(dtarg1)
2298 iptr2 = loc(dtarg2)
2299 iptr3 = loc(dtarg3)
2300 iptr4 = loc(itarg1)
2301 iptr5 = loc(itarg2)
2302 iptr6 = loc(itarg3)
2303 iptr7 = loc(rtarg1)
2304 iptr8 = loc(rtarg2)
2305 iptr9 = loc(rtarg3)
2306 iptr10= loc(chtarg1)
2307 iptr11= loc(chtarg2)
2308 iptr12= loc(chtarg3)
2309 iptr13= loc(ch8targ1)
2310 iptr14= loc(ch8targ2)
2311 iptr15= loc(ch8targ3)
2314 do, i=1,n
2315 dpte1(i)%i1=i
2316 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
2317 ! Error #261
2318 errors(261) = .true.
2319 endif
2321 dtarg1(i)%i1=2*dpte1(i)%i1
2322 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
2323 ! Error #262
2324 errors(262) = .true.
2325 endif
2327 ipte1(i) = i
2328 if (intne(ipte1(i), itarg1(i))) then
2329 ! Error #263
2330 errors(263) = .true.
2331 endif
2333 itarg1(i) = -ipte1(i)
2334 if (intne(ipte1(i), itarg1(i))) then
2335 ! Error #264
2336 errors(264) = .true.
2337 endif
2339 rpte1(i) = i * 5.0
2340 if (realne(rpte1(i), rtarg1(i))) then
2341 ! Error #265
2342 errors(265) = .true.
2343 endif
2345 rtarg1(i) = i * (-5.0)
2346 if (realne(rpte1(i), rtarg1(i))) then
2347 ! Error #266
2348 errors(266) = .true.
2349 endif
2351 chpte1(i) = 'a'
2352 if (chne(chpte1(i), chtarg1(i))) then
2353 ! Error #267
2354 errors(267) = .true.
2355 endif
2357 chtarg1(i) = 'z'
2358 if (chne(chpte1(i), chtarg1(i))) then
2359 ! Error #268
2360 errors(268) = .true.
2361 endif
2363 ch8pte1(i) = 'aaaaaaaa'
2364 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2365 ! Error #269
2366 errors(269) = .true.
2367 endif
2369 ch8targ1(i) = 'zzzzzzzz'
2370 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2371 ! Error #270
2372 errors(270) = .true.
2373 endif
2375 do, j=1,m
2376 dpte2(j,i)%r1=1.0
2377 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
2378 ! Error #271
2379 errors(271) = .true.
2380 endif
2382 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
2383 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
2384 ! Error #272
2385 errors(272) = .true.
2386 endif
2388 ipte2(j,i) = i
2389 if (intne(ipte2(j,i), itarg2(j,i))) then
2390 ! Error #273
2391 errors(273) = .true.
2392 endif
2394 itarg2(j,i) = -ipte2(j,i)
2395 if (intne(ipte2(j,i), itarg2(j,i))) then
2396 ! Error #274
2397 errors(274) = .true.
2398 endif
2400 rpte2(j,i) = i * (-2.0)
2401 if (realne(rpte2(j,i), rtarg2(j,i))) then
2402 ! Error #275
2403 errors(275) = .true.
2404 endif
2406 rtarg2(j,i) = i * (-3.0)
2407 if (realne(rpte2(j,i), rtarg2(j,i))) then
2408 ! Error #276
2409 errors(276) = .true.
2410 endif
2412 chpte2(j,i) = 'a'
2413 if (chne(chpte2(j,i), chtarg2(j,i))) then
2414 ! Error #277
2415 errors(277) = .true.
2416 endif
2418 chtarg2(j,i) = 'z'
2419 if (chne(chpte2(j,i), chtarg2(j,i))) then
2420 ! Error #278
2421 errors(278) = .true.
2422 endif
2424 ch8pte2(j,i) = 'aaaaaaaa'
2425 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
2426 ! Error #279
2427 errors(279) = .true.
2428 endif
2430 ch8targ2(j,i) = 'zzzzzzzz'
2431 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
2432 ! Error #280
2433 errors(280) = .true.
2434 endif
2435 do k=1,o
2436 dpte3(k,j,i)%i2(1+mod(i,5))=i
2437 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
2438 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
2439 ! Error #281
2440 errors(281) = .true.
2441 endif
2443 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
2444 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
2445 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
2446 ! Error #282
2447 errors(282) = .true.
2448 endif
2450 ipte3(k,j,i) = i
2451 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
2452 ! Error #283
2453 errors(283) = .true.
2454 endif
2456 itarg3(k,j,i) = -ipte3(k,j,i)
2457 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
2458 ! Error #284
2459 errors(284) = .true.
2460 endif
2462 rpte3(k,j,i) = i * 2.0
2463 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
2464 ! Error #285
2465 errors(285) = .true.
2466 endif
2468 rtarg3(k,j,i) = i * 3.0
2469 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
2470 ! Error #286
2471 errors(286) = .true.
2472 endif
2474 chpte3(k,j,i) = 'a'
2475 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
2476 ! Error #287
2477 errors(287) = .true.
2478 endif
2480 chtarg3(k,j,i) = 'z'
2481 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
2482 ! Error #288
2483 errors(288) = .true.
2484 endif
2486 ch8pte3(k,j,i) = 'aaaaaaaa'
2487 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
2488 ! Error #289
2489 errors(289) = .true.
2490 endif
2492 ch8targ3(k,j,i) = 'zzzzzzzz'
2493 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
2494 ! Error #290
2495 errors(290) = .true.
2496 endif
2497 end do
2498 end do
2499 end do
2501 rtarg3 = .5
2502 ! Vector syntax
2503 do, i=1,n
2504 ipte3 = i
2505 rpte3 = rpte3+1
2506 do, j=1,m
2507 do k=1,o
2508 if (intne(itarg3(k,j,i), i)) then
2509 ! Error #291
2510 errors(291) = .true.
2511 endif
2513 if (realne(rtarg3(k,j,i), i+.5)) then
2514 ! Error #292
2515 errors(292) = .true.
2516 endif
2517 end do
2518 end do
2519 end do
2521 end subroutine ptr9
2523 subroutine ptr10(nnn,mmm,ooo)
2524 common /errors/errors(400)
2525 logical :: errors, intne, realne, chne, ch8ne
2526 integer :: i,j,k
2527 integer :: nnn,mmm,ooo
2528 integer, parameter :: n = 9
2529 integer, parameter :: m = 10
2530 integer, parameter :: o = 11
2531 integer itarg1 (n)
2532 integer itarg2 (m,n)
2533 integer itarg3 (o,m,n)
2534 real rtarg1(n)
2535 real rtarg2(m,n)
2536 real rtarg3(o,m,n)
2537 character chtarg1(n)
2538 character chtarg2(m,n)
2539 character chtarg3(o,m,n)
2540 character*8 ch8targ1(n)
2541 character*8 ch8targ2(m,n)
2542 character*8 ch8targ3(o,m,n)
2543 type drvd
2544 real r1
2545 integer i1
2546 integer i2(5)
2547 end type drvd
2548 type(drvd) dtarg1(n)
2549 type(drvd) dtarg2(m,n)
2550 type(drvd) dtarg3(o,m,n)
2552 type(drvd) dpte1
2553 type(drvd) dpte2
2554 type(drvd) dpte3
2555 integer ipte1
2556 integer ipte2
2557 integer ipte3
2558 real rpte1
2559 real rpte2
2560 real rpte3
2561 character chpte1
2562 character chpte2
2563 character chpte3
2564 character*8 ch8pte1
2565 character*8 ch8pte2
2566 character*8 ch8pte3
2568 pointer(iptr1,dpte1(nnn))
2569 pointer(iptr2,dpte2(mmm,nnn))
2570 pointer(iptr3,dpte3(ooo,mmm,nnn))
2571 pointer(iptr4,ipte1(nnn))
2572 pointer(iptr5,ipte2 (mmm,nnn))
2573 pointer(iptr6,ipte3(ooo,mmm,nnn))
2574 pointer(iptr7,rpte1(nnn))
2575 pointer(iptr8,rpte2(mmm,nnn))
2576 pointer(iptr9,rpte3(ooo,mmm,nnn))
2577 pointer(iptr10,chpte1(nnn))
2578 pointer(iptr11,chpte2(mmm,nnn))
2579 pointer(iptr12,chpte3(ooo,mmm,nnn))
2580 pointer(iptr13,ch8pte1(nnn))
2581 pointer(iptr14,ch8pte2(mmm,nnn))
2582 pointer(iptr15,ch8pte3(ooo,mmm,nnn))
2584 iptr1 = loc(dtarg1)
2585 iptr2 = loc(dtarg2)
2586 iptr3 = loc(dtarg3)
2587 iptr4 = loc(itarg1)
2588 iptr5 = loc(itarg2)
2589 iptr6 = loc(itarg3)
2590 iptr7 = loc(rtarg1)
2591 iptr8 = loc(rtarg2)
2592 iptr9 = loc(rtarg3)
2593 iptr10= loc(chtarg1)
2594 iptr11= loc(chtarg2)
2595 iptr12= loc(chtarg3)
2596 iptr13= loc(ch8targ1)
2597 iptr14= loc(ch8targ2)
2598 iptr15= loc(ch8targ3)
2600 do, i=1,n
2601 dpte1(i)%i1=i
2602 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
2603 ! Error #293
2604 errors(293) = .true.
2605 endif
2607 dtarg1(i)%i1=2*dpte1(i)%i1
2608 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
2609 ! Error #294
2610 errors(294) = .true.
2611 endif
2613 ipte1(i) = i
2614 if (intne(ipte1(i), itarg1(i))) then
2615 ! Error #295
2616 errors(295) = .true.
2617 endif
2619 itarg1(i) = -ipte1(i)
2620 if (intne(ipte1(i), itarg1(i))) then
2621 ! Error #296
2622 errors(296) = .true.
2623 endif
2625 rpte1(i) = i * 5.0
2626 if (realne(rpte1(i), rtarg1(i))) then
2627 ! Error #297
2628 errors(297) = .true.
2629 endif
2631 rtarg1(i) = i * (-5.0)
2632 if (realne(rpte1(i), rtarg1(i))) then
2633 ! Error #298
2634 errors(298) = .true.
2635 endif
2637 chpte1(i) = 'a'
2638 if (chne(chpte1(i), chtarg1(i))) then
2639 ! Error #299
2640 errors(299) = .true.
2641 endif
2643 chtarg1(i) = 'z'
2644 if (chne(chpte1(i), chtarg1(i))) then
2645 ! Error #300
2646 errors(300) = .true.
2647 endif
2649 ch8pte1(i) = 'aaaaaaaa'
2650 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2651 ! Error #301
2652 errors(301) = .true.
2653 endif
2655 ch8targ1(i) = 'zzzzzzzz'
2656 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2657 ! Error #302
2658 errors(302) = .true.
2659 endif
2661 do, j=1,m
2662 dpte2(j,i)%r1=1.0
2663 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
2664 ! Error #303
2665 errors(303) = .true.
2666 endif
2668 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
2669 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
2670 ! Error #304
2671 errors(304) = .true.
2672 endif
2674 ipte2(j,i) = i
2675 if (intne(ipte2(j,i), itarg2(j,i))) then
2676 ! Error #305
2677 errors(305) = .true.
2678 endif
2680 itarg2(j,i) = -ipte2(j,i)
2681 if (intne(ipte2(j,i), itarg2(j,i))) then
2682 ! Error #306
2683 errors(306) = .true.
2684 endif
2686 rpte2(j,i) = i * (-2.0)
2687 if (realne(rpte2(j,i), rtarg2(j,i))) then
2688 ! Error #307
2689 errors(307) = .true.
2690 endif
2692 rtarg2(j,i) = i * (-3.0)
2693 if (realne(rpte2(j,i), rtarg2(j,i))) then
2694 ! Error #308
2695 errors(308) = .true.
2696 endif
2698 chpte2(j,i) = 'a'
2699 if (chne(chpte2(j,i), chtarg2(j,i))) then
2700 ! Error #309
2701 errors(309) = .true.
2702 endif
2704 chtarg2(j,i) = 'z'
2705 if (chne(chpte2(j,i), chtarg2(j,i))) then
2706 ! Error #310
2707 errors(310) = .true.
2708 endif
2710 ch8pte2(j,i) = 'aaaaaaaa'
2711 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
2712 ! Error #311
2713 errors(311) = .true.
2714 endif
2716 ch8targ2(j,i) = 'zzzzzzzz'
2717 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
2718 ! Error #312
2719 errors(312) = .true.
2720 endif
2721 do k=1,o
2722 dpte3(k,j,i)%i2(1+mod(i,5))=i
2723 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
2724 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
2725 ! Error #313
2726 errors(313) = .true.
2727 endif
2729 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
2730 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
2731 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
2732 ! Error #314
2733 errors(314) = .true.
2734 endif
2736 ipte3(k,j,i) = i
2737 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
2738 ! Error #315
2739 errors(315) = .true.
2740 endif
2742 itarg3(k,j,i) = -ipte3(k,j,i)
2743 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
2744 ! Error #316
2745 errors(316) = .true.
2746 endif
2748 rpte3(k,j,i) = i * 2.0
2749 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
2750 ! Error #317
2751 errors(317) = .true.
2752 endif
2754 rtarg3(k,j,i) = i * 3.0
2755 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
2756 ! Error #318
2757 errors(318) = .true.
2758 endif
2760 chpte3(k,j,i) = 'a'
2761 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
2762 ! Error #319
2763 errors(319) = .true.
2764 endif
2766 chtarg3(k,j,i) = 'z'
2767 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
2768 ! Error #320
2769 errors(320) = .true.
2770 endif
2772 ch8pte3(k,j,i) = 'aaaaaaaa'
2773 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
2774 ! Error #321
2775 errors(321) = .true.
2776 endif
2778 ch8targ3(k,j,i) = 'zzzzzzzz'
2779 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
2780 ! Error #322
2781 errors(322) = .true.
2782 endif
2783 end do
2784 end do
2785 end do
2787 rtarg3 = .5
2788 ! Vector syntax
2789 do, i=1,n
2790 ipte3 = i
2791 rpte3 = rpte3+1
2792 do, j=1,m
2793 do k=1,o
2794 if (intne(itarg3(k,j,i), i)) then
2795 ! Error #323
2796 errors(323) = .true.
2797 endif
2799 if (realne(rtarg3(k,j,i), i+.5)) then
2800 ! Error #324
2801 errors(324) = .true.
2802 endif
2803 end do
2804 end do
2805 end do
2806 end subroutine ptr10
2808 subroutine ptr11(nnn,mmm,ooo)
2809 common /errors/errors(400)
2810 logical :: errors, intne, realne, chne, ch8ne
2811 integer :: i,j,k
2812 integer :: nnn,mmm,ooo
2813 integer, parameter :: n = 9
2814 integer, parameter :: m = 10
2815 integer, parameter :: o = 11
2816 integer itarg1 (n)
2817 integer itarg2 (m,n)
2818 integer itarg3 (o,m,n)
2819 real rtarg1(n)
2820 real rtarg2(m,n)
2821 real rtarg3(o,m,n)
2822 character chtarg1(n)
2823 character chtarg2(m,n)
2824 character chtarg3(o,m,n)
2825 character*8 ch8targ1(n)
2826 character*8 ch8targ2(m,n)
2827 character*8 ch8targ3(o,m,n)
2828 type drvd
2829 real r1
2830 integer i1
2831 integer i2(5)
2832 end type drvd
2833 type(drvd) dtarg1(n)
2834 type(drvd) dtarg2(m,n)
2835 type(drvd) dtarg3(o,m,n)
2837 pointer(iptr1,dpte1(nnn))
2838 pointer(iptr2,dpte2(mmm,nnn))
2839 pointer(iptr3,dpte3(ooo,mmm,nnn))
2840 pointer(iptr4,ipte1(nnn))
2841 pointer(iptr5,ipte2 (mmm,nnn))
2842 pointer(iptr6,ipte3(ooo,mmm,nnn))
2843 pointer(iptr7,rpte1(nnn))
2844 pointer(iptr8,rpte2(mmm,nnn))
2845 pointer(iptr9,rpte3(ooo,mmm,nnn))
2846 pointer(iptr10,chpte1(nnn))
2847 pointer(iptr11,chpte2(mmm,nnn))
2848 pointer(iptr12,chpte3(ooo,mmm,nnn))
2849 pointer(iptr13,ch8pte1(nnn))
2850 pointer(iptr14,ch8pte2(mmm,nnn))
2851 pointer(iptr15,ch8pte3(ooo,mmm,nnn))
2853 type(drvd) dpte1
2854 type(drvd) dpte2
2855 type(drvd) dpte3
2856 integer ipte1
2857 integer ipte2
2858 integer ipte3
2859 real rpte1
2860 real rpte2
2861 real rpte3
2862 character chpte1
2863 character chpte2
2864 character chpte3
2865 character*8 ch8pte1
2866 character*8 ch8pte2
2867 character*8 ch8pte3
2869 iptr1 = loc(dtarg1)
2870 iptr2 = loc(dtarg2)
2871 iptr3 = loc(dtarg3)
2872 iptr4 = loc(itarg1)
2873 iptr5 = loc(itarg2)
2874 iptr6 = loc(itarg3)
2875 iptr7 = loc(rtarg1)
2876 iptr8 = loc(rtarg2)
2877 iptr9 = loc(rtarg3)
2878 iptr10= loc(chtarg1)
2879 iptr11= loc(chtarg2)
2880 iptr12= loc(chtarg3)
2881 iptr13= loc(ch8targ1)
2882 iptr14= loc(ch8targ2)
2883 iptr15= loc(ch8targ3)
2885 do, i=1,n
2886 dpte1(i)%i1=i
2887 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
2888 ! Error #325
2889 errors(325) = .true.
2890 endif
2892 dtarg1(i)%i1=2*dpte1(i)%i1
2893 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
2894 ! Error #326
2895 errors(326) = .true.
2896 endif
2898 ipte1(i) = i
2899 if (intne(ipte1(i), itarg1(i))) then
2900 ! Error #327
2901 errors(327) = .true.
2902 endif
2904 itarg1(i) = -ipte1(i)
2905 if (intne(ipte1(i), itarg1(i))) then
2906 ! Error #328
2907 errors(328) = .true.
2908 endif
2910 rpte1(i) = i * 5.0
2911 if (realne(rpte1(i), rtarg1(i))) then
2912 ! Error #329
2913 errors(329) = .true.
2914 endif
2916 rtarg1(i) = i * (-5.0)
2917 if (realne(rpte1(i), rtarg1(i))) then
2918 ! Error #330
2919 errors(330) = .true.
2920 endif
2922 chpte1(i) = 'a'
2923 if (chne(chpte1(i), chtarg1(i))) then
2924 ! Error #331
2925 errors(331) = .true.
2926 endif
2928 chtarg1(i) = 'z'
2929 if (chne(chpte1(i), chtarg1(i))) then
2930 ! Error #332
2931 errors(332) = .true.
2932 endif
2934 ch8pte1(i) = 'aaaaaaaa'
2935 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2936 ! Error #333
2937 errors(333) = .true.
2938 endif
2940 ch8targ1(i) = 'zzzzzzzz'
2941 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2942 ! Error #334
2943 errors(334) = .true.
2944 endif
2946 do, j=1,m
2947 dpte2(j,i)%r1=1.0
2948 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
2949 ! Error #335
2950 errors(335) = .true.
2951 endif
2953 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
2954 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
2955 ! Error #336
2956 errors(336) = .true.
2957 endif
2959 ipte2(j,i) = i
2960 if (intne(ipte2(j,i), itarg2(j,i))) then
2961 ! Error #337
2962 errors(337) = .true.
2963 endif
2965 itarg2(j,i) = -ipte2(j,i)
2966 if (intne(ipte2(j,i), itarg2(j,i))) then
2967 ! Error #338
2968 errors(338) = .true.
2969 endif
2971 rpte2(j,i) = i * (-2.0)
2972 if (realne(rpte2(j,i), rtarg2(j,i))) then
2973 ! Error #339
2974 errors(339) = .true.
2975 endif
2977 rtarg2(j,i) = i * (-3.0)
2978 if (realne(rpte2(j,i), rtarg2(j,i))) then
2979 ! Error #340
2980 errors(340) = .true.
2981 endif
2983 chpte2(j,i) = 'a'
2984 if (chne(chpte2(j,i), chtarg2(j,i))) then
2985 ! Error #341
2986 errors(341) = .true.
2987 endif
2989 chtarg2(j,i) = 'z'
2990 if (chne(chpte2(j,i), chtarg2(j,i))) then
2991 ! Error #342
2992 errors(342) = .true.
2993 endif
2995 ch8pte2(j,i) = 'aaaaaaaa'
2996 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
2997 ! Error #343
2998 errors(343) = .true.
2999 endif
3001 ch8targ2(j,i) = 'zzzzzzzz'
3002 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
3003 ! Error #344
3004 errors(344) = .true.
3005 endif
3006 do k=1,o
3007 dpte3(k,j,i)%i2(1+mod(i,5))=i
3008 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
3009 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
3010 ! Error #345
3011 errors(345) = .true.
3012 endif
3014 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
3015 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
3016 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
3017 ! Error #346
3018 errors(346) = .true.
3019 endif
3021 ipte3(k,j,i) = i
3022 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
3023 ! Error #347
3024 errors(347) = .true.
3025 endif
3027 itarg3(k,j,i) = -ipte3(k,j,i)
3028 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
3029 ! Error #348
3030 errors(348) = .true.
3031 endif
3033 rpte3(k,j,i) = i * 2.0
3034 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
3035 ! Error #349
3036 errors(349) = .true.
3037 endif
3039 rtarg3(k,j,i) = i * 3.0
3040 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
3041 ! Error #350
3042 errors(350) = .true.
3043 endif
3045 chpte3(k,j,i) = 'a'
3046 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
3047 ! Error #351
3048 errors(351) = .true.
3049 endif
3051 chtarg3(k,j,i) = 'z'
3052 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
3053 ! Error #352
3054 errors(352) = .true.
3055 endif
3057 ch8pte3(k,j,i) = 'aaaaaaaa'
3058 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
3059 ! Error #353
3060 errors(353) = .true.
3061 endif
3063 ch8targ3(k,j,i) = 'zzzzzzzz'
3064 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
3065 ! Error #354
3066 errors(354) = .true.
3067 endif
3068 end do
3069 end do
3070 end do
3072 rtarg3 = .5
3073 ! Vector syntax
3074 do, i=1,n
3075 ipte3 = i
3076 rpte3 = rpte3+1
3077 do, j=1,m
3078 do k=1,o
3079 if (intne(itarg3(k,j,i), i)) then
3080 ! Error #355
3081 errors(355) = .true.
3082 endif
3084 if (realne(rtarg3(k,j,i), i+.5)) then
3085 ! Error #356
3086 errors(356) = .true.
3087 endif
3088 end do
3089 end do
3090 end do
3091 end subroutine ptr11
3093 subroutine ptr12(nnn,mmm,ooo)
3094 common /errors/errors(400)
3095 logical :: errors, intne, realne, chne, ch8ne
3096 integer :: i,j,k
3097 integer :: nnn,mmm,ooo
3098 integer, parameter :: n = 9
3099 integer, parameter :: m = 10
3100 integer, parameter :: o = 11
3101 integer itarg1 (n)
3102 integer itarg2 (m,n)
3103 integer itarg3 (o,m,n)
3104 real rtarg1(n)
3105 real rtarg2(m,n)
3106 real rtarg3(o,m,n)
3107 character chtarg1(n)
3108 character chtarg2(m,n)
3109 character chtarg3(o,m,n)
3110 character*8 ch8targ1(n)
3111 character*8 ch8targ2(m,n)
3112 character*8 ch8targ3(o,m,n)
3113 type drvd
3114 real r1
3115 integer i1
3116 integer i2(5)
3117 end type drvd
3118 type(drvd) dtarg1(n)
3119 type(drvd) dtarg2(m,n)
3120 type(drvd) dtarg3(o,m,n)
3122 pointer(iptr1,dpte1)
3123 pointer(iptr2,dpte2)
3124 pointer(iptr3,dpte3)
3125 pointer(iptr4,ipte1)
3126 pointer(iptr5,ipte2)
3127 pointer(iptr6,ipte3)
3128 pointer(iptr7,rpte1)
3129 pointer(iptr8,rpte2)
3130 pointer(iptr9,rpte3)
3131 pointer(iptr10,chpte1)
3132 pointer(iptr11,chpte2)
3133 pointer(iptr12,chpte3)
3134 pointer(iptr13,ch8pte1)
3135 pointer(iptr14,ch8pte2)
3136 pointer(iptr15,ch8pte3)
3138 type(drvd) dpte1(nnn)
3139 type(drvd) dpte2(mmm,nnn)
3140 type(drvd) dpte3(ooo,mmm,nnn)
3141 integer ipte1 (nnn)
3142 integer ipte2 (mmm,nnn)
3143 integer ipte3 (ooo,mmm,nnn)
3144 real rpte1(nnn)
3145 real rpte2(mmm,nnn)
3146 real rpte3(ooo,mmm,nnn)
3147 character chpte1(nnn)
3148 character chpte2(mmm,nnn)
3149 character chpte3(ooo,mmm,nnn)
3150 character*8 ch8pte1(nnn)
3151 character*8 ch8pte2(mmm,nnn)
3152 character*8 ch8pte3(ooo,mmm,nnn)
3154 iptr1 = loc(dtarg1)
3155 iptr2 = loc(dtarg2)
3156 iptr3 = loc(dtarg3)
3157 iptr4 = loc(itarg1)
3158 iptr5 = loc(itarg2)
3159 iptr6 = loc(itarg3)
3160 iptr7 = loc(rtarg1)
3161 iptr8 = loc(rtarg2)
3162 iptr9 = loc(rtarg3)
3163 iptr10= loc(chtarg1)
3164 iptr11= loc(chtarg2)
3165 iptr12= loc(chtarg3)
3166 iptr13= loc(ch8targ1)
3167 iptr14= loc(ch8targ2)
3168 iptr15= loc(ch8targ3)
3171 do, i=1,n
3172 dpte1(i)%i1=i
3173 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
3174 ! Error #357
3175 errors(357) = .true.
3176 endif
3178 dtarg1(i)%i1=2*dpte1(i)%i1
3179 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
3180 ! Error #358
3181 errors(358) = .true.
3182 endif
3184 ipte1(i) = i
3185 if (intne(ipte1(i), itarg1(i))) then
3186 ! Error #359
3187 errors(359) = .true.
3188 endif
3190 itarg1(i) = -ipte1(i)
3191 if (intne(ipte1(i), itarg1(i))) then
3192 ! Error #360
3193 errors(360) = .true.
3194 endif
3196 rpte1(i) = i * 5.0
3197 if (realne(rpte1(i), rtarg1(i))) then
3198 ! Error #361
3199 errors(361) = .true.
3200 endif
3202 rtarg1(i) = i * (-5.0)
3203 if (realne(rpte1(i), rtarg1(i))) then
3204 ! Error #362
3205 errors(362) = .true.
3206 endif
3208 chpte1(i) = 'a'
3209 if (chne(chpte1(i), chtarg1(i))) then
3210 ! Error #363
3211 errors(363) = .true.
3212 endif
3214 chtarg1(i) = 'z'
3215 if (chne(chpte1(i), chtarg1(i))) then
3216 ! Error #364
3217 errors(364) = .true.
3218 endif
3220 ch8pte1(i) = 'aaaaaaaa'
3221 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
3222 ! Error #365
3223 errors(365) = .true.
3224 endif
3226 ch8targ1(i) = 'zzzzzzzz'
3227 if (ch8ne(ch8pte1(i), ch8targ1(i))) then
3228 ! Error #366
3229 errors(366) = .true.
3230 endif
3232 do, j=1,m
3233 dpte2(j,i)%r1=1.0
3234 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
3235 ! Error #367
3236 errors(367) = .true.
3237 endif
3239 dtarg2(j,i)%r1=2*dpte2(j,i)%r1
3240 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
3241 ! Error #368
3242 errors(368) = .true.
3243 endif
3245 ipte2(j,i) = i
3246 if (intne(ipte2(j,i), itarg2(j,i))) then
3247 ! Error #369
3248 errors(369) = .true.
3249 endif
3251 itarg2(j,i) = -ipte2(j,i)
3252 if (intne(ipte2(j,i), itarg2(j,i))) then
3253 ! Error #370
3254 errors(370) = .true.
3255 endif
3257 rpte2(j,i) = i * (-2.0)
3258 if (realne(rpte2(j,i), rtarg2(j,i))) then
3259 ! Error #371
3260 errors(371) = .true.
3261 endif
3263 rtarg2(j,i) = i * (-3.0)
3264 if (realne(rpte2(j,i), rtarg2(j,i))) then
3265 ! Error #372
3266 errors(372) = .true.
3267 endif
3269 chpte2(j,i) = 'a'
3270 if (chne(chpte2(j,i), chtarg2(j,i))) then
3271 ! Error #373
3272 errors(373) = .true.
3273 endif
3275 chtarg2(j,i) = 'z'
3276 if (chne(chpte2(j,i), chtarg2(j,i))) then
3277 ! Error #374
3278 errors(374) = .true.
3279 endif
3281 ch8pte2(j,i) = 'aaaaaaaa'
3282 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
3283 ! Error #375
3284 errors(375) = .true.
3285 endif
3287 ch8targ2(j,i) = 'zzzzzzzz'
3288 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
3289 ! Error #376
3290 errors(376) = .true.
3291 endif
3292 do k=1,o
3293 dpte3(k,j,i)%i2(1+mod(i,5))=i
3294 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
3295 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
3296 ! Error #377
3297 errors(377) = .true.
3298 endif
3300 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
3301 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
3302 dtarg3(k,j,i)%i2(1+mod(i,5)))) then
3303 ! Error #378
3304 errors(378) = .true.
3305 endif
3307 ipte3(k,j,i) = i
3308 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
3309 ! Error #379
3310 errors(379) = .true.
3311 endif
3313 itarg3(k,j,i) = -ipte3(k,j,i)
3314 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
3315 ! Error #380
3316 errors(380) = .true.
3317 endif
3319 rpte3(k,j,i) = i * 2.0
3320 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
3321 ! Error #381
3322 errors(381) = .true.
3323 endif
3325 rtarg3(k,j,i) = i * 3.0
3326 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
3327 ! Error #382
3328 errors(382) = .true.
3329 endif
3331 chpte3(k,j,i) = 'a'
3332 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
3333 ! Error #383
3334 errors(383) = .true.
3335 endif
3337 chtarg3(k,j,i) = 'z'
3338 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
3339 ! Error #384
3340 errors(384) = .true.
3341 endif
3343 ch8pte3(k,j,i) = 'aaaaaaaa'
3344 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
3345 ! Error #385
3346 errors(385) = .true.
3347 endif
3349 ch8targ3(k,j,i) = 'zzzzzzzz'
3350 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
3351 ! Error #386
3352 errors(386) = .true.
3353 endif
3354 end do
3355 end do
3356 end do
3358 rtarg3 = .5
3359 ! Vector syntax
3360 do, i=1,n
3361 ipte3 = i
3362 rpte3 = rpte3+1
3363 do, j=1,m
3364 do k=1,o
3365 if (intne(itarg3(k,j,i), i)) then
3366 ! Error #387
3367 errors(387) = .true.
3368 endif
3370 if (realne(rtarg3(k,j,i), i+.5)) then
3371 ! Error #388
3372 errors(388) = .true.
3373 endif
3374 end do
3375 end do
3376 end do
3378 end subroutine ptr12
3380 ! Misc
3381 subroutine ptr13(nnn,mmm)
3382 common /errors/errors(400)
3383 logical :: errors, intne, realne, chne, ch8ne
3384 integer :: nnn,mmm
3385 integer :: i,j
3386 integer, parameter :: n = 9
3387 integer, parameter :: m = 10
3388 integer itarg1 (n)
3389 integer itarg2 (m,n)
3390 real rtarg1(n)
3391 real rtarg2(m,n)
3393 integer ipte1
3394 integer ipte2
3395 real rpte1
3396 real rpte2
3398 dimension ipte1(n)
3399 dimension rpte2(mmm,nnn)
3401 pointer(iptr4,ipte1)
3402 pointer(iptr5,ipte2)
3403 pointer(iptr7,rpte1)
3404 pointer(iptr8,rpte2)
3406 dimension ipte2(mmm,nnn)
3407 dimension rpte1(n)
3409 iptr4 = loc(itarg1)
3410 iptr5 = loc(itarg2)
3411 iptr7 = loc(rtarg1)
3412 iptr8 = loc(rtarg2)
3414 do, i=1,n
3415 ipte1(i) = i
3416 if (intne(ipte1(i), itarg1(i))) then
3417 ! Error #389
3418 errors(389) = .true.
3419 endif
3421 itarg1(i) = -ipte1(i)
3422 if (intne(ipte1(i), itarg1(i))) then
3423 ! Error #390
3424 errors(390) = .true.
3425 endif
3427 rpte1(i) = i * 5.0
3428 if (realne(rpte1(i), rtarg1(i))) then
3429 ! Error #391
3430 errors(391) = .true.
3431 endif
3433 rtarg1(i) = i * (-5.0)
3434 if (realne(rpte1(i), rtarg1(i))) then
3435 ! Error #392
3436 errors(392) = .true.
3437 endif
3439 do, j=1,m
3440 ipte2(j,i) = i
3441 if (intne(ipte2(j,i), itarg2(j,i))) then
3442 ! Error #393
3443 errors(393) = .true.
3444 endif
3446 itarg2(j,i) = -ipte2(j,i)
3447 if (intne(ipte2(j,i), itarg2(j,i))) then
3448 ! Error #394
3449 errors(394) = .true.
3450 endif
3452 rpte2(j,i) = i * (-2.0)
3453 if (realne(rpte2(j,i), rtarg2(j,i))) then
3454 ! Error #395
3455 errors(395) = .true.
3456 endif
3458 rtarg2(j,i) = i * (-3.0)
3459 if (realne(rpte2(j,i), rtarg2(j,i))) then
3460 ! Error #396
3461 errors(396) = .true.
3462 endif
3464 end do
3465 end do
3466 end subroutine ptr13
3469 ! Test the passing of pointers and pointees as parameters
3470 subroutine parmtest
3471 integer, parameter :: n = 12
3472 integer, parameter :: m = 13
3473 integer iarray(m,n)
3474 pointer (ipt,iptee)
3475 integer iptee (m,n)
3477 ipt = loc(iarray)
3478 ! write(*,*) "loc(iarray)",loc(iarray)
3479 call parmptr(ipt,iarray,n,m)
3480 ! write(*,*) "loc(iptee)",loc(iptee)
3481 call parmpte(iptee,iarray,n,m)
3482 end subroutine parmtest
3484 subroutine parmptr(ipointer,intarr,n,m)
3485 common /errors/errors(400)
3486 logical :: errors, intne
3487 integer :: n,m,i,j
3488 integer intarr(m,n)
3489 pointer (ipointer,newpte)
3490 integer newpte(m,n)
3491 ! write(*,*) "loc(newpte)",loc(newpte)
3492 ! write(*,*) "loc(intarr)",loc(intarr)
3493 ! write(*,*) "loc(newpte(1,1))",loc(newpte(1,1))
3494 ! newpte(1,1) = 101
3495 ! write(*,*) "newpte(1,1)=",newpte(1,1)
3496 ! write(*,*) "intarr(1,1)=",intarr(1,1)
3497 do, i=1,n
3498 do, j=1,m
3499 newpte(j,i) = i
3500 if (intne(newpte(j,i),intarr(j,i))) then
3501 ! Error #397
3502 errors(397) = .true.
3503 endif
3505 call donothing(newpte(j,i),intarr(j,i))
3506 intarr(j,i) = -newpte(j,i)
3507 if (intne(newpte(j,i),intarr(j,i))) then
3508 ! Error #398
3509 errors(398) = .true.
3510 endif
3511 end do
3512 end do
3513 end subroutine parmptr
3515 subroutine parmpte(pointee,intarr,n,m)
3516 common /errors/errors(400)
3517 logical :: errors, intne
3518 integer :: n,m,i,j
3519 integer pointee (m,n)
3520 integer intarr (m,n)
3521 ! write(*,*) "loc(pointee)",loc(pointee)
3522 ! write(*,*) "loc(intarr)",loc(intarr)
3523 ! write(*,*) "loc(pointee(1,1))",loc(pointee(1,1))
3524 ! pointee(1,1) = 99
3525 ! write(*,*) "pointee(1,1)=",pointee(1,1)
3526 ! write(*,*) "intarr(1,1)=",intarr(1,1)
3528 do, i=1,n
3529 do, j=1,m
3530 pointee(j,i) = i
3531 if (intne(pointee(j,i),intarr(j,i))) then
3532 ! Error #399
3533 errors(399) = .true.
3534 endif
3536 intarr(j,i) = 2*pointee(j,i)
3537 call donothing(pointee(j,i),intarr(j,i))
3538 if (intne(pointee(j,i),intarr(j,i))) then
3539 ! Error #400
3540 errors(400) = .true.
3541 endif
3542 end do
3543 end do
3544 end subroutine parmpte
3546 ! Separate function calls to break Cray pointer-indifferent optimization
3547 logical function intne(ii,jj)
3548 integer :: i,j
3549 common /foo/foo
3550 integer foo
3551 foo = foo + 1
3552 intne = ii.ne.jj
3553 if (intne) then
3554 write (*,*) ii," doesn't equal ",jj
3555 endif
3556 end function intne
3558 logical function realne(r1,r2)
3559 real :: r1, r2
3560 common /foo/foo
3561 integer foo
3562 foo = foo + 1
3563 realne = r1.ne.r2
3564 if (realne) then
3565 write (*,*) r1," doesn't equal ",r2
3566 endif
3567 end function realne
3569 logical function chne(ch1,ch2)
3570 character :: ch1, ch2
3571 common /foo/foo
3572 integer foo
3573 foo = foo + 1
3574 chne = ch1.ne.ch2
3575 if (chne) then
3576 write (*,*) ch1," doesn't equal ",ch2
3577 endif
3578 end function chne
3580 logical function ch8ne(ch1,ch2)
3581 character*8 :: ch1, ch2
3582 common /foo/foo
3583 integer foo
3584 foo = foo + 1
3585 ch8ne = ch1.ne.ch2
3586 if (ch8ne) then
3587 write (*,*) ch1," doesn't equal ",ch2
3588 endif
3589 end function ch8ne
3591 subroutine donothing(ii,jj)
3592 common/foo/foo
3593 integer :: ii,jj,foo
3594 if (foo.le.1) then
3595 foo = 1
3596 else
3597 foo = foo - 1
3598 endif
3599 if (foo.eq.0) then
3600 ii = -1
3601 jj = 1
3602 ! print *,"Test did not run correctly"
3603 call abort()
3604 endif
3605 end subroutine donothing