1! { dg-do run }
2
3module wrapper_mod
4
5type compute
6  integer, allocatable :: block(:,:)
7contains
8  procedure :: initialize
9end type compute
10
11type, extends(compute) :: cpu_compute
12  integer :: blocksize
13contains
14  procedure :: setblocksize
15end type cpu_compute
16
17type, extends(compute) :: gpu_compute
18  integer :: numgangs
19  integer :: numworkers
20  integer :: vectorsize
21  integer, allocatable :: gpu_block(:,:)
22contains
23  procedure :: setdims
24end type gpu_compute
25
26contains
27
28subroutine initialize(c, length, width)
29  implicit none
30  class(compute) :: c
31  integer :: length
32  integer :: width
33  integer :: i
34  integer :: j
35
36  allocate (c%block(length, width))
37
38  do i=1,length
39    do j=1, width
40      c%block(i,j) = i + j
41    end do
42  end do
43end subroutine initialize
44
45subroutine setdims(c, g, w, v)
46  implicit none
47  class(gpu_compute) :: c
48  integer :: g
49  integer :: w
50  integer :: v
51  c%numgangs = g
52  c%numworkers = w
53  c%vectorsize = v
54end subroutine setdims
55
56subroutine setblocksize(c, bs)
57  implicit none
58  class(cpu_compute) :: c
59  integer :: bs
60  c%blocksize = bs
61end subroutine setblocksize
62
63end module wrapper_mod
64
65program main
66  use wrapper_mod
67  implicit none
68  class(compute), allocatable, target :: mycomp
69  integer :: i, j
70
71  allocate(gpu_compute::mycomp)
72
73  call mycomp%initialize(1024,1024)
74
75  !$acc enter data copyin(mycomp)
76
77  select type (mycomp)
78  type is (cpu_compute)
79    call mycomp%setblocksize(32)
80  type is (gpu_compute)
81    call mycomp%setdims(32,32,32)
82    allocate(mycomp%gpu_block(1024,1024))
83    !$acc update device(mycomp)
84    !$acc parallel copyin(mycomp%block) copyout(mycomp%gpu_block)
85    !$acc loop gang worker vector collapse(2)
86    do i=1,1024
87      do j=1,1024
88        mycomp%gpu_block(i,j) = mycomp%block(i,j) + 1
89      end do
90    end do
91    !$acc end parallel
92  end select
93
94  !$acc exit data copyout(mycomp)
95
96  select type (g => mycomp)
97  type is (gpu_compute)
98  do i = 1, 1024
99    do j = 1, 1024
100      if (g%gpu_block(i,j) .ne. i + j + 1) stop 1
101    end do
102  end do
103  end select
104
105  deallocate(mycomp)
106end program main
107