Commit a3245fcb authored by Budiardja, Reuben's avatar Budiardja, Reuben
Browse files

Simple test case for OpenMP 5 unified_shared_memory.

parent 1fa569a6
module Real_1D__Form
!-- $OMP requires unified_shared_memory
implicit none
private
integer, public, parameter :: &
KDR = kind ( 1.0d0 )
real ( KDR ), public, parameter :: &
CONSTANT_PI = acos ( -1.0_KDR )
type, public :: Real_1D_Form
integer :: &
nValues
real ( KDR ), dimension ( : ), pointer :: &
Value
contains
procedure, public, pass :: &
Initialize
end type Real_1D_Form
contains
subroutine Initialize ( R_1D, nValues )
class ( Real_1D_Form ), intent ( inout ) :: &
R_1D
integer, intent ( in ) :: &
nValues
allocate ( R_1D % Value ( nValues ) )
R_1D % nValues = nValues
end subroutine Initialize
end module Real_1D__Form
program Real_1D_Form_Test
use Real_1D__Form
implicit none
integer :: &
iR, &
iV
real ( KDR ), dimension ( :, : ), allocatable :: &
A
type ( Real_1D_Form ), dimension ( : ), allocatable :: &
R_1D
allocate ( A ( 2, 2 ) )
A = 0.0_KDR
allocate ( R_1D ( 5 ) )
do iR = 1, size ( R_1D )
call R_1D ( iR ) % Initialize ( iR * 2 )
R_1D ( iR ) % Value = - huge ( 1.0_KDR )
end do
!$OMP target teams distribute parallel do &
!$OMP map ( to : R_1D ( 1 ) % Value, A )
do iV = 1, R_1D ( 1 ) % nValues
R_1D ( 1 ) % Value ( iV ) = CONSTANT_PI
A ( iV, iV ) = acos ( -1.0_KDR )
end do
!$OMP end target teams distribute parallel do
if ( all ( R_1D ( 1 ) % Value == CONSTANT_PI ) ) then
print*, 'PASSED'
STOP
else
print*, 'FAILED'
ERROR STOP
end if
!print*, 'R_1D ( 1 )', R_1D ( 1 ) % Value
!print*, 'R_1D ( 2 )', R_1D ( 2 ) % Value
!print*, 'A ( 1, 1 ), A ( 2, 2 )', A ( 1, 1 ), A ( 2, 2 )
end program Real_1D_Form_Test
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment