libgomp/testsuite/libgomp.oacc-fortran/deep-copy-7.f90

   1 ! { dg-do run }
   2
   3 ! Test of attach/detach with scalar elements and nested derived types.
   4
   5 program dtype
   6   implicit none
   7   integer, parameter :: n = 512
   8   type subtype
   9     integer :: g, h
  10     integer, allocatable :: q(:)
  11   end type subtype
  12   type mytype
  13     integer, allocatable :: a(:)
  14     integer, allocatable :: c, d
  15     integer, allocatable :: b(:)
  16     integer :: f
  17     type(subtype) :: s
  18   end type mytype
  19   integer i
  20
  21   type(mytype) :: var
  22
  23   allocate(var%a(1:n))
  24   allocate(var%b(1:n))
  25   allocate(var%c)
  26   allocate(var%d)
  27   allocate(var%s%q(1:n))
  28
  29   var%c = 16
  30   var%d = 20
  31   var%f = 7
  32   var%s%g = 21
  33   var%s%h = 38
  34
  35 !$acc enter data copyin(var)
  36
  37   do i = 1, n
  38     var%a(i) = 0
  39     var%b(i) = 0
  40     var%s%q(i) = 0
  41   end do
  42
  43 !$acc data copy(var%a(5:n - 5), var%b(5:n - 5), var%c, var%d) &
  44 !$acc & copy(var%s%q)
  45
  46 !$acc parallel loop default(none) present(var)
  47   do i = 5,n - 5
  48     var%a(i) = i
  49     var%b(i) = i * 2
  50     var%s%q(i) = i * 3
  51     var%s%g = 100
  52     var%s%h = 101
  53   end do
  54 !$acc end parallel loop
  55
  56 !$acc end data
  57
  58 !$acc exit data copyout(var)
  59
  60   do i = 1,4
  61     if (var%a(i) .ne. 0) stop 1
  62     if (var%b(i) .ne. 0) stop 2
  63     if (var%s%q(i) .ne. 0) stop 3
  64   end do
  65
  66   do i = 5,n - 5
  67     if (i .ne. var%a(i)) stop 4
  68     if (i * 2 .ne. var%b(i)) stop 5
  69     if (i * 3 .ne. var%s%q(i)) stop 6
  70   end do
  71
  72   do i = n - 4,n
  73     if (var%a(i) .ne. 0) stop 7
  74     if (var%b(i) .ne. 0) stop 8
  75     if (var%s%q(i) .ne. 0) stop 9
  76   end do
  77
  78   if (var%c .ne. 16) stop 10
  79   if (var%d .ne. 20) stop 11
  80   if (var%s%g .ne. 100 .or. var%s%h .ne. 101) stop 12
  81   if (var%f .ne. 7) stop 13
  82
  83   deallocate(var%a)
  84   deallocate(var%b)
  85   deallocate(var%c)
  86   deallocate(var%d)
  87   deallocate(var%s%q)
  88
  89 end program dtype