Retro68/gcc/libgomp/testsuite/libgomp.fortran/aligned1.f03

! { dg-do run }
! { dg-options "-fopenmp -fcray-pointer" }

  use iso_c_binding, only : c_ptr, c_ptrdiff_t, c_loc
  interface
    subroutine foo (x, y, z, w)
      use iso_c_binding, only : c_ptr
      real, pointer :: x(:), y(:), w(:)
      type(c_ptr) :: z
    end subroutine
    subroutine bar (x, y, z, w)
      use iso_c_binding, only : c_ptr
      real, pointer :: x(:), y(:), w(:)
      type(c_ptr) :: z
    end subroutine
    subroutine baz (x, c)
      real, pointer :: x(:)
      real, allocatable :: c(:)
    end subroutine
  end interface
  type dt
    real, allocatable :: a(:)
  end type
  type (dt) :: b(64)
  real, target :: a(4096+63)
  real, pointer :: p(:), q(:), r(:), s(:)
  real, allocatable :: c(:)
  integer(c_ptrdiff_t) :: o
  integer :: i
  o = 64 - mod (loc (a), 64)
  if (o == 64) o = 0
  o = o / sizeof(0.0)
  p => a(o + 1:o + 1024)
  q => a(o + 1025:o + 2048)
  r => a(o + 2049:o + 3072)
  s => a(o + 3073:o + 4096)
  do i = 1, 1024
    p(i) = i
    q(i) = i
    r(i) = i
    s(i) = i
  end do
  call foo (p, q, c_loc (r(1)), s)
  do i = 1, 1024
    if (p(i) /= i * i + 3 * i + 2) call abort
    p(i) = i
  end do
  call bar (p, q, c_loc (r(1)), s)
  do i = 1, 1024
    if (p(i) /= i * i + 3 * i + 2) call abort
  end do
  ! Attempt to create 64-byte aligned allocatable
  do i = 1, 64
    allocate (c(1023 + i))
    if (iand (loc (c(1)), 63) == 0) exit
    deallocate (c)
    allocate (b(i)%a(1023 + i))
    allocate (c(1023 + i))
    if (iand (loc (c(1)), 63) == 0) exit
    deallocate (c)
  end do
  if (allocated (c)) then
    do i = 1, 1024
      c(i) = 2 * i
    end do
    call baz (p, c)
    do i = 1, 1024
      if (p(i) /= i * i + 5 * i + 2) call abort
    end do
  end if
end
subroutine foo (x, y, z, w)
  use iso_c_binding, only : c_ptr, c_f_pointer
  real, pointer :: x(:), y(:), w(:), p(:)
  type(c_ptr) :: z
  integer :: i
  real :: pt(1024)
  pointer (ip, pt)
  ip = loc (w)
!$omp simd aligned (x, y : 64)
  do i = 1, 1024
    x(i) = x(i) * y(i) + 2.0
  end do
!$omp simd aligned (x, z : 64) private (p)
  do i = 1, 1024
    call c_f_pointer (z, p, shape=[1024])
    x(i) = x(i) + p(i)
  end do
!$omp simd aligned (x, ip : 64)
  do i = 1, 1024
    x(i) = x(i) + 2 * pt(i)
  end do
!$omp end simd
end subroutine
subroutine bar (x, y, z, w)
  use iso_c_binding, only : c_ptr, c_f_pointer
  real, pointer :: x(:), y(:), w(:), a(:), b(:)
  type(c_ptr) :: z, c
  integer :: i
  real :: pt(1024)
  pointer (ip, pt)
  ip = loc (w)
  a => x
  b => y
  c = z
!$omp simd aligned (a, b : 64)
  do i = 1, 1024
    a(i) = a(i) * b(i) + 2.0
  end do
!$omp simd aligned (a, c : 64)
  do i = 1, 1024
    block
      real, pointer :: p(:)
      call c_f_pointer (c, p, shape=[1024])
      a(i) = a(i) + p(i)
    end block
  end do
!$omp simd aligned (a, ip : 64)
  do i = 1, 1024
    a(i) = a(i) + 2 * pt(i)
  end do
!$omp end simd
end subroutine
subroutine baz (x, c)
  real, pointer :: x(:)
  real, allocatable :: c(:)
  integer :: i
!$omp simd aligned (x, c : 64)
  do i = 1, 1024
    x(i) = x(i) + c(i)
  end do
!$omp end simd
end subroutine baz