libgomp/testsuite/libgomp.oacc-fortran/classtypes-2.f95

   1 ! { dg-do run }
   2
   3 module wrapper_mod
   4
   5 type compute
   6   integer, allocatable :: block(:,:)
   7 contains
   8   procedure :: initialize
   9 end type compute
  10
  11 type, extends(compute) :: cpu_compute
  12   integer :: blocksize
  13 contains
  14   procedure :: setblocksize
  15 end type cpu_compute
  16
  17 type, extends(compute) :: gpu_compute
  18   integer :: numgangs
  19   integer :: numworkers
  20   integer :: vectorsize
  21   integer, allocatable :: gpu_block(:,:)
  22 contains
  23   procedure :: setdims
  24 end type gpu_compute
  25
  26 contains
  27
  28 subroutine 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
  43 end subroutine initialize
  44
  45 subroutine 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
  54 end subroutine setdims
  55
  56 subroutine setblocksize(c, bs)
  57   implicit none
  58   class(cpu_compute) :: c
  59   integer :: bs
  60   c%blocksize = bs
  61 end subroutine setblocksize
  62
  63 end module wrapper_mod
  64
  65 program 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)
 106 end program main