libgomp/testsuite/libgomp.fortran/aligned1.f03

   1 ! { dg-do run }
   2 ! { dg-options "-fcray-pointer" }
   3
   4   use iso_c_binding, only : c_ptr, c_ptrdiff_t, c_loc
   5   interface
   6     subroutine foo (x, y, z, w)
   7       use iso_c_binding, only : c_ptr
   8       real, pointer :: x(:), y(:), w(:)
   9       type(c_ptr) :: z
  10     end subroutine
  11     subroutine bar (x, y, z, w)
  12       use iso_c_binding, only : c_ptr
  13       real, pointer :: x(:), y(:), w(:)
  14       type(c_ptr) :: z
  15     end subroutine
  16     subroutine baz (x, c)
  17       real, pointer :: x(:)
  18       real, allocatable :: c(:)
  19     end subroutine
  20   end interface
  21   type dt
  22     real, allocatable :: a(:)
  23   end type
  24   type (dt) :: b(64)
  25   real, target :: a(4096+63)
  26   real, pointer :: p(:), q(:), r(:), s(:)
  27   real, allocatable :: c(:)
  28   integer(c_ptrdiff_t) :: o
  29   integer :: i
  30   o = 64 - mod (loc (a), 64)
  31   if (o == 64) o = 0
  32   o = o / sizeof(0.0)
  33   p => a(o + 1:o + 1024)
  34   q => a(o + 1025:o + 2048)
  35   r => a(o + 2049:o + 3072)
  36   s => a(o + 3073:o + 4096)
  37   do i = 1, 1024
  38     p(i) = i
  39     q(i) = i
  40     r(i) = i
  41     s(i) = i
  42   end do
  43   call foo (p, q, c_loc (r(1)), s)
  44   do i = 1, 1024
  45     if (p(i) /= i * i + 3 * i + 2) STOP 1
  46     p(i) = i
  47   end do
  48   call bar (p, q, c_loc (r(1)), s)
  49   do i = 1, 1024
  50     if (p(i) /= i * i + 3 * i + 2) STOP 2
  51   end do
  52   ! Attempt to create 64-byte aligned allocatable
  53   do i = 1, 64
  54     allocate (c(1023 + i))
  55     if (iand (loc (c(1)), 63) == 0) exit
  56     deallocate (c)
  57     allocate (b(i)%a(1023 + i))
  58     allocate (c(1023 + i))
  59     if (iand (loc (c(1)), 63) == 0) exit
  60     deallocate (c)
  61   end do
  62   if (allocated (c)) then
  63     do i = 1, 1024
  64       c(i) = 2 * i
  65     end do
  66     call baz (p, c)
  67     do i = 1, 1024
  68       if (p(i) /= i * i + 5 * i + 2) STOP 3
  69     end do
  70   end if
  71 end
  72 subroutine foo (x, y, z, w)
  73   use iso_c_binding, only : c_ptr, c_f_pointer
  74   real, pointer :: x(:), y(:), w(:), p(:)
  75   type(c_ptr) :: z
  76   integer :: i
  77   real :: pt(1024)
  78   pointer (ip, pt)
  79   ip = loc (w)
  80 !$omp simd aligned (x, y : 64)
  81   do i = 1, 1024
  82     x(i) = x(i) * y(i) + 2.0
  83   end do
  84 !$omp simd aligned (x, z : 64) private (p)
  85   do i = 1, 1024
  86     call c_f_pointer (z, p, shape=[1024])
  87     x(i) = x(i) + p(i)
  88   end do
  89 !$omp simd aligned (x, ip : 64)
  90   do i = 1, 1024
  91     x(i) = x(i) + 2 * pt(i)
  92   end do
  93 !$omp end simd
  94 end subroutine
  95 subroutine bar (x, y, z, w)
  96   use iso_c_binding, only : c_ptr, c_f_pointer
  97   real, pointer :: x(:), y(:), w(:), a(:), b(:)
  98   type(c_ptr) :: z, c
  99   integer :: i
 100   real :: pt(1024)
 101   pointer (ip, pt)
 102   ip = loc (w)
 103   a => x
 104   b => y
 105   c = z
 106 !$omp simd aligned (a, b : 64)
 107   do i = 1, 1024
 108     a(i) = a(i) * b(i) + 2.0
 109   end do
 110 !$omp simd aligned (a, c : 64)
 111   do i = 1, 1024
 112     block
 113       real, pointer :: p(:)
 114       call c_f_pointer (c, p, shape=[1024])
 115       a(i) = a(i) + p(i)
 116     end block
 117   end do
 118 !$omp simd aligned (a, ip : 64)
 119   do i = 1, 1024
 120     a(i) = a(i) + 2 * pt(i)
 121   end do
 122 !$omp end simd
 123 end subroutine
 124 subroutine baz (x, c)
 125   real, pointer :: x(:)
 126   real, allocatable :: c(:)
 127   integer :: i
 128 !$omp simd aligned (x, c : 64)
 129   do i = 1, 1024
 130     x(i) = x(i) + c(i)
 131   end do
 132 !$omp end simd
 133 end subroutine baz