libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90

   1 ! { dg-do run }
   2
   3 type type1
   4   integer, allocatable :: arr1(:,:)
   5 end type type1
   6
   7 type type2
   8   type(type1) :: t1
   9 end type type2
  10
  11 type type3
  12   type(type2) :: t2(20)
  13 end type type3
  14
  15 type type4
  16   type(type3), allocatable :: t3(:)
  17 end type type4
  18
  19 integer :: i, j, k
  20
  21 type(type4), allocatable :: var1(:)
  22 type(type4) :: var2
  23 type(type3) :: var3
  24
  25 allocate(var1(1:20))
  26 do i=1,20
  27   allocate(var1(i)%t3(1:20))
  28   do j=1,20
  29     do k=1,20
  30       allocate(var1(i)%t3(j)%t2(k)%t1%arr1(1:20,1:20))
  31     end do
  32   end do
  33 end do
  34
  35 allocate(var2%t3(1:20))
  36 do i=1,20
  37   do j=1,20
  38     allocate(var2%t3(i)%t2(j)%t1%arr1(1:20,1:20))
  39   end do
  40 end do
  41
  42 do i=1,20
  43   do j=1,20
  44     do k=1,20
  45       var1(i)%t3(j)%t2(k)%t1%arr1(:,:) = 0
  46     end do
  47     var2%t3(i)%t2(j)%t1%arr1(:,:) = 0
  48   end do
  49 end do
  50
  51 !$acc enter data copyin(var2%t3(4)%t2(3)%t1%arr1(:,:))
  52 !$acc enter data copyin(var1(5)%t3(4)%t2(3)%t1%arr1(:,:))
  53
  54 var2%t3(4)%t2(3)%t1%arr1(:,:) = 5
  55 var1(5)%t3(4)%t2(3)%t1%arr1(:,:) = 4
  56
  57 !$acc update device(var2%t3(4)%t2(3)%t1%arr1)
  58 !$acc update device(var1(5)%t3(4)%t2(3)%t1%arr1)
  59
  60 !$acc exit data copyout(var1(5)%t3(4)%t2(3)%t1%arr1(:,:))
  61 !$acc exit data copyout(var2%t3(4)%t2(3)%t1%arr1(:,:))
  62
  63 do i=1,20
  64   do j=1,20
  65     do k=1,20
  66       if (i.eq.5 .and. j.eq.4 .and. k.eq.3) then
  67         if (any(var1(i)%t3(j)%t2(k)%t1%arr1 .ne. 4)) stop 1
  68       else
  69         if (any(var1(i)%t3(j)%t2(k)%t1%arr1 .ne. 0)) stop 2
  70       end if
  71     end do
  72     if (i.eq.4 .and. j.eq.3) then
  73       if (any(var2%t3(i)%t2(j)%t1%arr1 .ne. 5)) stop 3
  74     else
  75       if (any(var2%t3(i)%t2(j)%t1%arr1 .ne. 0)) stop 4
  76     end if
  77   end do
  78 end do
  79
  80 do i=1,20
  81   allocate(var3%t2(i)%t1%arr1(1:20, 1:20))
  82   var3%t2(i)%t1%arr1(:,:) = 0
  83 end do
  84
  85 !$acc enter data copyin(var3)
  86 !$acc enter data copyin(var3%t2(:))
  87 !$acc enter data copyin(var3%t2(5)%t1)
  88 !$acc data copyin(var3%t2(5)%t1%arr1)
  89
  90 !$acc serial present(var3%t2(5)%t1%arr1)
  91 ! { dg-warning "using .vector_length \\(32\\)., ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 }
  92 var3%t2(5)%t1%arr1(:,:) = 6
  93 !$acc end serial
  94
  95 !$acc update host(var3%t2(5)%t1%arr1)
  96
  97 !$acc end data
  98 !$acc exit data delete(var3%t2(5)%t1)
  99 !$acc exit data delete(var3%t2)
 100 !$acc exit data delete(var3)
 101
 102 do i=1,20
 103   if (i.eq.5) then
 104     if (any(var3%t2(i)%t1%arr1.ne.6)) stop 5
 105   else
 106     if (any(var3%t2(i)%t1%arr1.ne.0)) stop 6
 107   end if
 108 end do
 109
 110 end