OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [cray_pointers_2.f90] - Blame information for rev 193

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
! { dg-do run }
2
! { dg-options "-fcray-pointer -fbounds-check" }
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
39
 
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)
69
 
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)
85
 
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)
101
 
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)
117
 
118
 
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
125
 
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
131
 
132
     ipte1(i) = i
133
     if (intne(ipte1(i), itarg1(i))) then
134
        ! Error #15
135
        errors(15) = .true.
136
     endif
137
 
138
     itarg1(i) = -ipte1(i)
139
     if (intne(ipte1(i), itarg1(i))) then
140
        ! Error #16
141
        errors(16) = .true.
142
     endif
143
 
144
     rpte1(i) = i * 5.0
145
     if (realne(rpte1(i), rtarg1(i))) then
146
        ! Error #17
147
        errors(17) = .true.
148
     endif
149
 
150
     rtarg1(i) = i * (-5.0)
151
     if (realne(rpte1(i), rtarg1(i))) then
152
        ! Error #18
153
        errors(18) = .true.
154
     endif
155
 
156
     chpte1(i) = 'a'
157
     if (chne(chpte1(i), chtarg1(i))) then
158
        ! Error #19
159
        errors(19) = .true.
160
     endif
161
 
162
     chtarg1(i) = 'z'
163
     if (chne(chpte1(i), chtarg1(i))) then
164
        ! Error #20
165
        errors(20) = .true.
166
     endif
167
 
168
     ch8pte1(i) = 'aaaaaaaa'
169
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
170
        ! Error #21
171
        errors(21) = .true.
172
     endif
173
 
174
     ch8targ1(i) = 'zzzzzzzz'
175
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
176
        ! Error #22
177
        errors(22) = .true.
178
     endif
179
 
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
186
 
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
192
 
193
        ipte2(j,i) = i
194
        if (intne(ipte2(j,i), itarg2(j,i))) then
195
           ! Error #25
196
           errors(25) = .true.
197
        endif
198
 
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
204
 
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
210
 
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
216
 
217
        chpte2(j,i) = 'a'
218
        if (chne(chpte2(j,i), chtarg2(j,i))) then
219
           ! Error #29
220
           errors(29) = .true.
221
        endif
222
 
223
        chtarg2(j,i) = 'z'
224
        if (chne(chpte2(j,i), chtarg2(j,i))) then
225
           ! Error #30
226
           errors(30) = .true.
227
        endif
228
 
229
        ch8pte2(j,i) = 'aaaaaaaa'
230
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
231
           ! Error #31
232
           errors(31) = .true.
233
        endif
234
 
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
247
 
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
254
 
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
260
 
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
266
 
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
272
 
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
278
 
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
284
 
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
290
 
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
296
 
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
305
 
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
317
 
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
325
 
326
end subroutine ptr1
327
 
328
 
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)
356
 
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
372
 
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))
388
 
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)
404
 
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
411
 
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
417
 
418
     ipte1(i) = i
419
     if (intne(ipte1(i), itarg1(i))) then
420
        ! Error #47
421
        errors(47) = .true.
422
     endif
423
 
424
     itarg1(i) = -ipte1(i)
425
     if (intne(ipte1(i), itarg1(i))) then
426
        ! Error #48
427
        errors(48) = .true.
428
     endif
429
 
430
     rpte1(i) = i * 5.0
431
     if (realne(rpte1(i), rtarg1(i))) then
432
        ! Error #49
433
        errors(49) = .true.
434
     endif
435
 
436
     rtarg1(i) = i * (-5.0)
437
     if (realne(rpte1(i), rtarg1(i))) then
438
        ! Error #50
439
        errors(50) = .true.
440
     endif
441
 
442
     chpte1(i) = 'a'
443
     if (chne(chpte1(i), chtarg1(i))) then
444
        ! Error #51
445
        errors(51) = .true.
446
     endif
447
 
448
     chtarg1(i) = 'z'
449
     if (chne(chpte1(i), chtarg1(i))) then
450
        ! Error #52
451
        errors(52) = .true.
452
     endif
453
 
454
     ch8pte1(i) = 'aaaaaaaa'
455
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
456
        ! Error #53
457
        errors(53) = .true.
458
     endif
459
 
460
     ch8targ1(i) = 'zzzzzzzz'
461
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
462
        ! Error #54
463
        errors(54) = .true.
464
     endif
465
 
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
472
 
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
478
 
479
        ipte2(j,i) = i
480
        if (intne(ipte2(j,i), itarg2(j,i))) then
481
           ! Error #57
482
           errors(57) = .true.
483
        endif
484
 
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
490
 
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
496
 
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
502
 
503
        chpte2(j,i) = 'a'
504
        if (chne(chpte2(j,i), chtarg2(j,i))) then
505
           ! Error #61
506
           errors(61) = .true.
507
        endif
508
 
509
        chtarg2(j,i) = 'z'
510
        if (chne(chpte2(j,i), chtarg2(j,i))) then
511
           ! Error #62
512
           errors(62) = .true.
513
        endif
514
 
515
        ch8pte2(j,i) = 'aaaaaaaa'
516
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
517
           ! Error #63
518
           errors(63) = .true.
519
        endif
520
 
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
532
 
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
538
 
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
544
 
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
550
 
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
556
 
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
562
 
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
568
 
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
574
 
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
580
 
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
589
 
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
601
 
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
610
 
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)
638
 
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))
654
 
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
670
 
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)
686
 
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
693
 
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
699
 
700
     ipte1(i) = i
701
     if (intne(ipte1(i), itarg1(i))) then
702
        ! Error #79
703
        errors(79) = .true.
704
     endif
705
 
706
     itarg1(i) = -ipte1(i)
707
     if (intne(ipte1(i), itarg1(i))) then
708
        ! Error #80
709
        errors(80) = .true.
710
     endif
711
 
712
     rpte1(i) = i * 5.0
713
     if (realne(rpte1(i), rtarg1(i))) then
714
        ! Error #81
715
        errors(81) = .true.
716
     endif
717
 
718
     rtarg1(i) = i * (-5.0)
719
     if (realne(rpte1(i), rtarg1(i))) then
720
        ! Error #82
721
        errors(82) = .true.
722
     endif
723
 
724
     chpte1(i) = 'a'
725
     if (chne(chpte1(i), chtarg1(i))) then
726
        ! Error #83
727
        errors(83) = .true.
728
     endif
729
 
730
     chtarg1(i) = 'z'
731
     if (chne(chpte1(i), chtarg1(i))) then
732
        ! Error #84
733
        errors(84) = .true.
734
     endif
735
 
736
     ch8pte1(i) = 'aaaaaaaa'
737
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
738
        ! Error #85
739
        errors(85) = .true.
740
     endif
741
 
742
     ch8targ1(i) = 'zzzzzzzz'
743
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
744
        ! Error #86
745
        errors(86) = .true.
746
     endif
747
 
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
754
 
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
760
 
761
        ipte2(j,i) = i
762
        if (intne(ipte2(j,i), itarg2(j,i))) then
763
           ! Error #89
764
           errors(89) = .true.
765
        endif
766
 
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
772
 
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
778
 
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
784
 
785
        chpte2(j,i) = 'a'
786
        if (chne(chpte2(j,i), chtarg2(j,i))) then
787
           ! Error #93
788
           errors(93) = .true.
789
        endif
790
 
791
        chtarg2(j,i) = 'z'
792
        if (chne(chpte2(j,i), chtarg2(j,i))) then
793
           ! Error #94
794
           errors(94) = .true.
795
        endif
796
 
797
        ch8pte2(j,i) = 'aaaaaaaa'
798
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
799
           ! Error #95
800
           errors(95) = .true.
801
        endif
802
 
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
815
 
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
822
 
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
828
 
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
834
 
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
840
 
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
846
 
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
852
 
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
858
 
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
864
 
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
873
 
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
885
 
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
894
 
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)
922
 
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)
930
 
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)
946
 
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)
962
 
963
 
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
970
 
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
976
 
977
     ipte1(i) = i
978
     if (intne(ipte1(i), itarg1(i))) then
979
        ! Error #111
980
        errors(111) = .true.
981
     endif
982
 
983
     itarg1(i) = -ipte1(i)
984
     if (intne(ipte1(i), itarg1(i))) then
985
        ! Error #112
986
        errors(112) = .true.
987
     endif
988
 
989
     rpte1(i) = i * 5.0
990
     if (realne(rpte1(i), rtarg1(i))) then
991
        ! Error #113
992
        errors(113) = .true.
993
     endif
994
 
995
     rtarg1(i) = i * (-5.0)
996
     if (realne(rpte1(i), rtarg1(i))) then
997
        ! Error #114
998
        errors(114) = .true.
999
     endif
1000
 
1001
     chpte1(i) = 'a'
1002
     if (chne(chpte1(i), chtarg1(i))) then
1003
        ! Error #115
1004
        errors(115) = .true.
1005
     endif
1006
 
1007
     chtarg1(i) = 'z'
1008
     if (chne(chpte1(i), chtarg1(i))) then
1009
        ! Error #116
1010
        errors(116) = .true.
1011
     endif
1012
 
1013
     ch8pte1(i) = 'aaaaaaaa'
1014
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1015
        ! Error #117
1016
        errors(117) = .true.
1017
     endif
1018
 
1019
     ch8targ1(i) = 'zzzzzzzz'
1020
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1021
        ! Error #118
1022
        errors(118) = .true.
1023
     endif
1024
 
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
1031
 
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
1037
 
1038
        ipte2(j,i) = i
1039
        if (intne(ipte2(j,i), itarg2(j,i))) then
1040
           ! Error #121
1041
           errors(121) = .true.
1042
        endif
1043
 
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
1049
 
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
1055
 
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
1061
 
1062
        chpte2(j,i) = 'a'
1063
        if (chne(chpte2(j,i), chtarg2(j,i))) then
1064
           ! Error #125
1065
           errors(125) = .true.
1066
        endif
1067
 
1068
        chtarg2(j,i) = 'z'
1069
        if (chne(chpte2(j,i), chtarg2(j,i))) then
1070
           ! Error #126
1071
           errors(126) = .true.
1072
        endif
1073
 
1074
        ch8pte2(j,i) = 'aaaaaaaa'
1075
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1076
           ! Error #127
1077
           errors(127) = .true.
1078
        endif
1079
 
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
1092
 
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
1099
 
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
1105
 
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
1111
 
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
1117
 
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
1123
 
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
1129
 
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
1135
 
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
1141
 
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
1150
 
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
1162
 
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
1170
 
1171
end subroutine ptr4
1172
 
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)
1200
 
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,*)
1216
 
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)
1232
 
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)
1248
 
1249
 
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
1256
 
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
1262
 
1263
     ipte1(i) = i
1264
     if (intne(ipte1(i), itarg1(i))) then
1265
        ! Error #143
1266
        errors(143) = .true.
1267
     endif
1268
 
1269
     itarg1(i) = -ipte1(i)
1270
     if (intne(ipte1(i), itarg1(i))) then
1271
        ! Error #144
1272
        errors(144) = .true.
1273
     endif
1274
 
1275
     rpte1(i) = i * 5.0
1276
     if (realne(rpte1(i), rtarg1(i))) then
1277
        ! Error #145
1278
        errors(145) = .true.
1279
     endif
1280
 
1281
     rtarg1(i) = i * (-5.0)
1282
     if (realne(rpte1(i), rtarg1(i))) then
1283
        ! Error #146
1284
        errors(146) = .true.
1285
     endif
1286
 
1287
     chpte1(i) = 'a'
1288
     if (chne(chpte1(i), chtarg1(i))) then
1289
        ! Error #147
1290
        errors(147) = .true.
1291
     endif
1292
 
1293
     chtarg1(i) = 'z'
1294
     if (chne(chpte1(i), chtarg1(i))) then
1295
        ! Error #148
1296
        errors(148) = .true.
1297
     endif
1298
 
1299
     ch8pte1(i) = 'aaaaaaaa'
1300
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1301
        ! Error #149
1302
        errors(149) = .true.
1303
     endif
1304
 
1305
     ch8targ1(i) = 'zzzzzzzz'
1306
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1307
        ! Error #150
1308
        errors(150) = .true.
1309
     endif
1310
 
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
1317
 
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
1323
 
1324
        ipte2(j,i) = i
1325
        if (intne(ipte2(j,i), itarg2(j,i))) then
1326
           ! Error #153
1327
           errors(153) = .true.
1328
        endif
1329
 
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
1335
 
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
1341
 
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
1347
 
1348
        chpte2(j,i) = 'a'
1349
        if (chne(chpte2(j,i), chtarg2(j,i))) then
1350
           ! Error #157
1351
           errors(157) = .true.
1352
        endif
1353
 
1354
        chtarg2(j,i) = 'z'
1355
        if (chne(chpte2(j,i), chtarg2(j,i))) then
1356
           ! Error #158
1357
           errors(158) = .true.
1358
        endif
1359
 
1360
        ch8pte2(j,i) = 'aaaaaaaa'
1361
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1362
           ! Error #159
1363
           errors(159) = .true.
1364
        endif
1365
 
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
1378
 
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
1385
 
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
1391
 
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
1397
 
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
1403
 
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
1409
 
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
1415
 
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
1421
 
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
1427
 
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
1436
 
1437
end subroutine ptr5
1438
 
1439
 
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)
1467
 
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
1483
 
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,*))
1499
 
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)
1515
 
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
1522
 
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
1528
 
1529
     ipte1(i) = i
1530
     if (intne(ipte1(i), itarg1(i))) then
1531
        ! Error #173
1532
        errors(173) = .true.
1533
     endif
1534
 
1535
     itarg1(i) = -ipte1(i)
1536
     if (intne(ipte1(i), itarg1(i))) then
1537
        ! Error #174
1538
        errors(174) = .true.
1539
     endif
1540
 
1541
     rpte1(i) = i * 5.0
1542
     if (realne(rpte1(i), rtarg1(i))) then
1543
        ! Error #175
1544
        errors(175) = .true.
1545
     endif
1546
 
1547
     rtarg1(i) = i * (-5.0)
1548
     if (realne(rpte1(i), rtarg1(i))) then
1549
        ! Error #176
1550
        errors(176) = .true.
1551
     endif
1552
 
1553
     chpte1(i) = 'a'
1554
     if (chne(chpte1(i), chtarg1(i))) then
1555
        ! Error #177
1556
        errors(177) = .true.
1557
     endif
1558
 
1559
     chtarg1(i) = 'z'
1560
     if (chne(chpte1(i), chtarg1(i))) then
1561
        ! Error #178
1562
        errors(178) = .true.
1563
     endif
1564
 
1565
     ch8pte1(i) = 'aaaaaaaa'
1566
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1567
        ! Error #179
1568
        errors(179) = .true.
1569
     endif
1570
 
1571
     ch8targ1(i) = 'zzzzzzzz'
1572
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1573
        ! Error #180
1574
        errors(180) = .true.
1575
     endif
1576
 
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
1583
 
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
1589
 
1590
        ipte2(j,i) = i
1591
        if (intne(ipte2(j,i), itarg2(j,i))) then
1592
           ! Error #183
1593
           errors(183) = .true.
1594
        endif
1595
 
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
1601
 
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
1607
 
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
1613
 
1614
        chpte2(j,i) = 'a'
1615
        if (chne(chpte2(j,i), chtarg2(j,i))) then
1616
           ! Error #187
1617
           errors(187) = .true.
1618
        endif
1619
 
1620
        chtarg2(j,i) = 'z'
1621
        if (chne(chpte2(j,i), chtarg2(j,i))) then
1622
           ! Error #188
1623
           errors(188) = .true.
1624
        endif
1625
 
1626
        ch8pte2(j,i) = 'aaaaaaaa'
1627
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1628
           ! Error #189
1629
           errors(189) = .true.
1630
        endif
1631
 
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
1644
 
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
1651
 
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
1657
 
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
1663
 
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
1669
 
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
1675
 
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
1681
 
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
1687
 
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
1693
 
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
1702
 
1703
end subroutine ptr6
1704
 
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)
1732
 
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,*))
1748
 
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
1764
 
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)
1780
 
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
1787
 
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
1793
 
1794
     ipte1(i) = i
1795
     if (intne(ipte1(i), itarg1(i))) then
1796
        ! Error #203
1797
        errors(203) = .true.
1798
     endif
1799
 
1800
     itarg1(i) = -ipte1(i)
1801
     if (intne(ipte1(i), itarg1(i))) then
1802
        ! Error #204
1803
        errors(204) = .true.
1804
     endif
1805
 
1806
     rpte1(i) = i * 5.0
1807
     if (realne(rpte1(i), rtarg1(i))) then
1808
        ! Error #205
1809
        errors(205) = .true.
1810
     endif
1811
 
1812
     rtarg1(i) = i * (-5.0)
1813
     if (realne(rpte1(i), rtarg1(i))) then
1814
        ! Error #206
1815
        errors(206) = .true.
1816
     endif
1817
 
1818
     chpte1(i) = 'a'
1819
     if (chne(chpte1(i), chtarg1(i))) then
1820
        ! Error #207
1821
        errors(207) = .true.
1822
     endif
1823
 
1824
     chtarg1(i) = 'z'
1825
     if (chne(chpte1(i), chtarg1(i))) then
1826
        ! Error #208
1827
        errors(208) = .true.
1828
     endif
1829
 
1830
     ch8pte1(i) = 'aaaaaaaa'
1831
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1832
        ! Error #209
1833
        errors(209) = .true.
1834
     endif
1835
 
1836
     ch8targ1(i) = 'zzzzzzzz'
1837
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
1838
        ! Error #210
1839
        errors(210) = .true.
1840
     endif
1841
 
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
1848
 
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
1854
 
1855
        ipte2(j,i) = i
1856
        if (intne(ipte2(j,i), itarg2(j,i))) then
1857
           ! Error #213
1858
           errors(213) = .true.
1859
        endif
1860
 
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
1866
 
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
1872
 
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
1878
 
1879
        chpte2(j,i) = 'a'
1880
        if (chne(chpte2(j,i), chtarg2(j,i))) then
1881
           ! Error #217
1882
           errors(217) = .true.
1883
        endif
1884
 
1885
        chtarg2(j,i) = 'z'
1886
        if (chne(chpte2(j,i), chtarg2(j,i))) then
1887
           ! Error #218
1888
           errors(218) = .true.
1889
        endif
1890
 
1891
        ch8pte2(j,i) = 'aaaaaaaa'
1892
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
1893
           ! Error #219
1894
           errors(219) = .true.
1895
        endif
1896
 
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
1909
 
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
1916
 
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
1922
 
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
1928
 
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
1934
 
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
1940
 
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
1946
 
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
1952
 
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
1958
 
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
1967
 
1968
end subroutine ptr7
1969
 
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)
1997
 
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)
2013
 
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,*)
2029
 
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)
2045
 
2046
 
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
2053
 
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
2059
 
2060
     ipte1(i) = i
2061
     if (intne(ipte1(i), itarg1(i))) then
2062
        ! Error #233
2063
        errors(233) = .true.
2064
     endif
2065
 
2066
     itarg1(i) = -ipte1(i)
2067
     if (intne(ipte1(i), itarg1(i))) then
2068
        ! Error #234
2069
        errors(234) = .true.
2070
     endif
2071
 
2072
     rpte1(i) = i * 5.0
2073
     if (realne(rpte1(i), rtarg1(i))) then
2074
        ! Error #235
2075
        errors(235) = .true.
2076
     endif
2077
 
2078
     rtarg1(i) = i * (-5.0)
2079
     if (realne(rpte1(i), rtarg1(i))) then
2080
        ! Error #236
2081
        errors(236) = .true.
2082
     endif
2083
 
2084
     chpte1(i) = 'a'
2085
     if (chne(chpte1(i), chtarg1(i))) then
2086
        ! Error #237
2087
        errors(237) = .true.
2088
     endif
2089
 
2090
     chtarg1(i) = 'z'
2091
     if (chne(chpte1(i), chtarg1(i))) then
2092
        ! Error #238
2093
        errors(238) = .true.
2094
     endif
2095
 
2096
     ch8pte1(i) = 'aaaaaaaa'
2097
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2098
        ! Error #239
2099
        errors(239) = .true.
2100
     endif
2101
 
2102
     ch8targ1(i) = 'zzzzzzzz'
2103
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2104
        ! Error #240
2105
        errors(240) = .true.
2106
     endif
2107
 
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
2114
 
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
2120
 
2121
        ipte2(j,i) = i
2122
        if (intne(ipte2(j,i), itarg2(j,i))) then
2123
           ! Error #243
2124
           errors(243) = .true.
2125
        endif
2126
 
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
2132
 
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
2138
 
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
2144
 
2145
        chpte2(j,i) = 'a'
2146
        if (chne(chpte2(j,i), chtarg2(j,i))) then
2147
           ! Error #247
2148
           errors(247) = .true.
2149
        endif
2150
 
2151
        chtarg2(j,i) = 'z'
2152
        if (chne(chpte2(j,i), chtarg2(j,i))) then
2153
           ! Error #248
2154
           errors(248) = .true.
2155
        endif
2156
 
2157
        ch8pte2(j,i) = 'aaaaaaaa'
2158
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
2159
           ! Error #249
2160
           errors(249) = .true.
2161
        endif
2162
 
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
2175
 
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
2182
 
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
2188
 
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
2194
 
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
2200
 
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
2206
 
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
2212
 
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
2218
 
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
2224
 
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
2234
 
2235
 
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)
2264
 
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)
2280
 
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)
2296
 
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)
2312
 
2313
 
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
2320
 
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
2326
 
2327
     ipte1(i) = i
2328
     if (intne(ipte1(i), itarg1(i))) then
2329
        ! Error #263
2330
        errors(263) = .true.
2331
     endif
2332
 
2333
     itarg1(i) = -ipte1(i)
2334
     if (intne(ipte1(i), itarg1(i))) then
2335
        ! Error #264
2336
        errors(264) = .true.
2337
     endif
2338
 
2339
     rpte1(i) = i * 5.0
2340
     if (realne(rpte1(i), rtarg1(i))) then
2341
        ! Error #265
2342
        errors(265) = .true.
2343
     endif
2344
 
2345
     rtarg1(i) = i * (-5.0)
2346
     if (realne(rpte1(i), rtarg1(i))) then
2347
        ! Error #266
2348
        errors(266) = .true.
2349
     endif
2350
 
2351
     chpte1(i) = 'a'
2352
     if (chne(chpte1(i), chtarg1(i))) then
2353
        ! Error #267
2354
        errors(267) = .true.
2355
     endif
2356
 
2357
     chtarg1(i) = 'z'
2358
     if (chne(chpte1(i), chtarg1(i))) then
2359
        ! Error #268
2360
        errors(268) = .true.
2361
     endif
2362
 
2363
     ch8pte1(i) = 'aaaaaaaa'
2364
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2365
        ! Error #269
2366
        errors(269) = .true.
2367
     endif
2368
 
2369
     ch8targ1(i) = 'zzzzzzzz'
2370
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2371
        ! Error #270
2372
        errors(270) = .true.
2373
     endif
2374
 
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
2381
 
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
2387
 
2388
        ipte2(j,i) = i
2389
        if (intne(ipte2(j,i), itarg2(j,i))) then
2390
           ! Error #273
2391
           errors(273) = .true.
2392
        endif
2393
 
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
2399
 
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
2405
 
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
2411
 
2412
        chpte2(j,i) = 'a'
2413
        if (chne(chpte2(j,i), chtarg2(j,i))) then
2414
           ! Error #277
2415
           errors(277) = .true.
2416
        endif
2417
 
2418
        chtarg2(j,i) = 'z'
2419
        if (chne(chpte2(j,i), chtarg2(j,i))) then
2420
           ! Error #278
2421
           errors(278) = .true.
2422
        endif
2423
 
2424
        ch8pte2(j,i) = 'aaaaaaaa'
2425
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
2426
           ! Error #279
2427
           errors(279) = .true.
2428
        endif
2429
 
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
2442
 
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
2449
 
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
2455
 
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
2461
 
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
2467
 
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
2473
 
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
2479
 
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
2485
 
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
2491
 
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
2500
 
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
2512
 
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
2520
 
2521
end subroutine ptr9
2522
 
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)
2551
 
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
2567
 
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))
2583
 
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)
2599
 
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
2606
 
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
2612
 
2613
     ipte1(i) = i
2614
     if (intne(ipte1(i), itarg1(i))) then
2615
        ! Error #295
2616
        errors(295) = .true.
2617
     endif
2618
 
2619
     itarg1(i) = -ipte1(i)
2620
     if (intne(ipte1(i), itarg1(i))) then
2621
        ! Error #296
2622
        errors(296) = .true.
2623
     endif
2624
 
2625
     rpte1(i) = i * 5.0
2626
     if (realne(rpte1(i), rtarg1(i))) then
2627
        ! Error #297
2628
        errors(297) = .true.
2629
     endif
2630
 
2631
     rtarg1(i) = i * (-5.0)
2632
     if (realne(rpte1(i), rtarg1(i))) then
2633
        ! Error #298
2634
        errors(298) = .true.
2635
     endif
2636
 
2637
     chpte1(i) = 'a'
2638
     if (chne(chpte1(i), chtarg1(i))) then
2639
        ! Error #299
2640
        errors(299) = .true.
2641
     endif
2642
 
2643
     chtarg1(i) = 'z'
2644
     if (chne(chpte1(i), chtarg1(i))) then
2645
        ! Error #300
2646
        errors(300) = .true.
2647
     endif
2648
 
2649
     ch8pte1(i) = 'aaaaaaaa'
2650
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2651
        ! Error #301
2652
        errors(301) = .true.
2653
     endif
2654
 
2655
     ch8targ1(i) = 'zzzzzzzz'
2656
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2657
        ! Error #302
2658
        errors(302) = .true.
2659
     endif
2660
 
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
2667
 
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
2673
 
2674
        ipte2(j,i) = i
2675
        if (intne(ipte2(j,i), itarg2(j,i))) then
2676
           ! Error #305
2677
           errors(305) = .true.
2678
        endif
2679
 
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
2685
 
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
2691
 
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
2697
 
2698
        chpte2(j,i) = 'a'
2699
        if (chne(chpte2(j,i), chtarg2(j,i))) then
2700
           ! Error #309
2701
           errors(309) = .true.
2702
        endif
2703
 
2704
        chtarg2(j,i) = 'z'
2705
        if (chne(chpte2(j,i), chtarg2(j,i))) then
2706
           ! Error #310
2707
           errors(310) = .true.
2708
        endif
2709
 
2710
        ch8pte2(j,i) = 'aaaaaaaa'
2711
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
2712
           ! Error #311
2713
           errors(311) = .true.
2714
        endif
2715
 
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
2728
 
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
2735
 
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
2741
 
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
2747
 
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
2753
 
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
2759
 
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
2765
 
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
2771
 
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
2777
 
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
2786
 
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
2798
 
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
2807
 
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)
2836
 
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))
2852
 
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
2868
 
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)
2884
 
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
2891
 
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
2897
 
2898
     ipte1(i) = i
2899
     if (intne(ipte1(i), itarg1(i))) then
2900
        ! Error #327
2901
        errors(327) = .true.
2902
     endif
2903
 
2904
     itarg1(i) = -ipte1(i)
2905
     if (intne(ipte1(i), itarg1(i))) then
2906
        ! Error #328
2907
        errors(328) = .true.
2908
     endif
2909
 
2910
     rpte1(i) = i * 5.0
2911
     if (realne(rpte1(i), rtarg1(i))) then
2912
        ! Error #329
2913
        errors(329) = .true.
2914
     endif
2915
 
2916
     rtarg1(i) = i * (-5.0)
2917
     if (realne(rpte1(i), rtarg1(i))) then
2918
        ! Error #330
2919
        errors(330) = .true.
2920
     endif
2921
 
2922
     chpte1(i) = 'a'
2923
     if (chne(chpte1(i), chtarg1(i))) then
2924
        ! Error #331
2925
        errors(331) = .true.
2926
     endif
2927
 
2928
     chtarg1(i) = 'z'
2929
     if (chne(chpte1(i), chtarg1(i))) then
2930
        ! Error #332
2931
        errors(332) = .true.
2932
     endif
2933
 
2934
     ch8pte1(i) = 'aaaaaaaa'
2935
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2936
        ! Error #333
2937
        errors(333) = .true.
2938
     endif
2939
 
2940
     ch8targ1(i) = 'zzzzzzzz'
2941
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
2942
        ! Error #334
2943
        errors(334) = .true.
2944
     endif
2945
 
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
2952
 
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
2958
 
2959
        ipte2(j,i) = i
2960
        if (intne(ipte2(j,i), itarg2(j,i))) then
2961
           ! Error #337
2962
           errors(337) = .true.
2963
        endif
2964
 
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
2970
 
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
2976
 
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
2982
 
2983
        chpte2(j,i) = 'a'
2984
        if (chne(chpte2(j,i), chtarg2(j,i))) then
2985
           ! Error #341
2986
           errors(341) = .true.
2987
        endif
2988
 
2989
        chtarg2(j,i) = 'z'
2990
        if (chne(chpte2(j,i), chtarg2(j,i))) then
2991
           ! Error #342
2992
           errors(342) = .true.
2993
        endif
2994
 
2995
        ch8pte2(j,i) = 'aaaaaaaa'
2996
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
2997
           ! Error #343
2998
           errors(343) = .true.
2999
        endif
3000
 
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
3013
 
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
3020
 
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
3026
 
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
3032
 
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
3038
 
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
3044
 
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
3050
 
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
3056
 
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
3062
 
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
3071
 
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
3083
 
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
3092
 
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)
3121
 
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)
3137
 
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)
3153
 
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)
3169
 
3170
 
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
3177
 
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
3183
 
3184
     ipte1(i) = i
3185
     if (intne(ipte1(i), itarg1(i))) then
3186
        ! Error #359
3187
        errors(359) = .true.
3188
     endif
3189
 
3190
     itarg1(i) = -ipte1(i)
3191
     if (intne(ipte1(i), itarg1(i))) then
3192
        ! Error #360
3193
        errors(360) = .true.
3194
     endif
3195
 
3196
     rpte1(i) = i * 5.0
3197
     if (realne(rpte1(i), rtarg1(i))) then
3198
        ! Error #361
3199
        errors(361) = .true.
3200
     endif
3201
 
3202
     rtarg1(i) = i * (-5.0)
3203
     if (realne(rpte1(i), rtarg1(i))) then
3204
        ! Error #362
3205
        errors(362) = .true.
3206
     endif
3207
 
3208
     chpte1(i) = 'a'
3209
     if (chne(chpte1(i), chtarg1(i))) then
3210
        ! Error #363
3211
        errors(363) = .true.
3212
     endif
3213
 
3214
     chtarg1(i) = 'z'
3215
     if (chne(chpte1(i), chtarg1(i))) then
3216
        ! Error #364
3217
        errors(364) = .true.
3218
     endif
3219
 
3220
     ch8pte1(i) = 'aaaaaaaa'
3221
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
3222
        ! Error #365
3223
        errors(365) = .true.
3224
     endif
3225
 
3226
     ch8targ1(i) = 'zzzzzzzz'
3227
     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
3228
        ! Error #366
3229
        errors(366) = .true.
3230
     endif
3231
 
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
3238
 
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
3244
 
3245
        ipte2(j,i) = i
3246
        if (intne(ipte2(j,i), itarg2(j,i))) then
3247
           ! Error #369
3248
           errors(369) = .true.
3249
        endif
3250
 
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
3256
 
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
3262
 
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
3268
 
3269
        chpte2(j,i) = 'a'
3270
        if (chne(chpte2(j,i), chtarg2(j,i))) then
3271
           ! Error #373
3272
           errors(373) = .true.
3273
        endif
3274
 
3275
        chtarg2(j,i) = 'z'
3276
        if (chne(chpte2(j,i), chtarg2(j,i))) then
3277
           ! Error #374
3278
           errors(374) = .true.
3279
        endif
3280
 
3281
        ch8pte2(j,i) = 'aaaaaaaa'
3282
        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
3283
           ! Error #375
3284
           errors(375) = .true.
3285
        endif
3286
 
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
3299
 
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
3306
 
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
3312
 
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
3318
 
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
3324
 
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
3330
 
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
3336
 
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
3342
 
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
3348
 
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
3357
 
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
3369
 
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
3377
 
3378
end subroutine ptr12
3379
 
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)
3392
 
3393
  integer ipte1
3394
  integer ipte2
3395
  real rpte1
3396
  real rpte2
3397
 
3398
  dimension ipte1(n)
3399
  dimension rpte2(mmm,nnn)
3400
 
3401
  pointer(iptr4,ipte1)
3402
  pointer(iptr5,ipte2)
3403
  pointer(iptr7,rpte1)
3404
  pointer(iptr8,rpte2)
3405
 
3406
  dimension ipte2(mmm,nnn)
3407
  dimension rpte1(n)
3408
 
3409
  iptr4 = loc(itarg1)
3410
  iptr5 = loc(itarg2)
3411
  iptr7 = loc(rtarg1)
3412
  iptr8 = loc(rtarg2)
3413
 
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
3420
 
3421
     itarg1(i) = -ipte1(i)
3422
     if (intne(ipte1(i), itarg1(i))) then
3423
        ! Error #390
3424
        errors(390) = .true.
3425
     endif
3426
 
3427
     rpte1(i) = i * 5.0
3428
     if (realne(rpte1(i), rtarg1(i))) then
3429
        ! Error #391
3430
        errors(391) = .true.
3431
     endif
3432
 
3433
     rtarg1(i) = i * (-5.0)
3434
     if (realne(rpte1(i), rtarg1(i))) then
3435
        ! Error #392
3436
        errors(392) = .true.
3437
     endif
3438
 
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
3445
 
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
3451
 
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
3457
 
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
3463
 
3464
     end do
3465
  end do
3466
end subroutine ptr13
3467
 
3468
 
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)
3476
 
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
3483
 
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
3504
 
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
3514
 
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)
3527
 
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
3535
 
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
3545
 
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
3557
 
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
3568
 
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
3579
 
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
3590
 
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
3606
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.