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