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

Expanded test with more checking. Still not working due to compiler limitation.

parent daf686a5
program OpenMP_metadirective_target_test
program OpenMP_metadirective_user_condition_target_test
use omp_lib
use iso_fortran_env
integer :: &
iV, &
implicit none
logical :: &
UseDevice
real ( real64 ) :: &
Timing
real ( real64 ), dimension ( : ), allocatable :: &
A, B, C
A, B, C, &
C_Ref
UseDevice = 1
print*, 'OnDevice ( ) :', OnDevice ( )
print*, ''
UseDevice = .true.
print*, 'UseDevice :', UseDevice
print*, 'OnDevice ( UseDevice ) :', OnDevice ( UseDevice )
print*, ''
UseDevice = .false.
print*, 'UseDevice :', UseDevice
print*, 'OnDevice ( UseDevice ) :', OnDevice ( UseDevice )
print*, ''
allocate ( A ( 1024 ) )
allocate ( B ( 1024 ) )
allocate ( C ( 1024 ) )
allocate ( A ( 1024*10 ) )
allocate ( B ( 1024*10 ) )
allocate ( C ( 1024*10 ) )
allocate ( C_Ref, source = C )
call random_number ( A )
call random_number ( B )
call random_number ( C )
!$OMP metadirective &
!$OMP when ( user = { condition ( UseDevice > 0 ) } : target )
C_Ref = A + B
print*, 'Calling ComputeAndTimeVectorAddition on Host'
C = 0.0_real64
UseDevice = .false.
call ComputeAndTimeVectorAddition &
( A, B, C, Timing, UseDeviceOption = UseDevice )
print*, 'Timing on host :', Timing
print*, 'Correct results :', all ( C == C_Ref )
print*, ''
print*, 'Calling ComputeAndTimeVectorAddition on Device'
C = 0.0_real64
UseDevice = .true.
call ComputeAndTimeVectorAddition &
( A, B, C, Timing, UseDeviceOption = UseDevice )
print*, 'Timing on device :', Timing
print*, 'Correct results :', all ( C == C_Ref )
print*, ''
contains
function OnDevice ( UseDeviceOption ) result ( OD )
logical, intent ( in ), optional :: &
UseDeviceOption
logical :: &
OD
logical :: &
UseDevice
UseDevice = .true.
if ( present ( UseDeviceOption ) ) &
UseDevice = UseDeviceOption
!$OMP begin metadirective &
!$OMP when ( user = { condition ( UseDevice .EQV. .true. ) } &
!$OMP : target map ( tofrom : OD ) )
OD = .not. omp_is_initial_device()
!$OMP end metadirective
end function OnDevice
subroutine ComputeAndTimeVectorAddition ( A, B, C, Timing, UseDeviceOption )
real ( real64 ), dimension ( : ), intent ( in ) :: &
A, B
real ( real64 ), dimension ( : ), intent ( out ) :: &
C
real ( real64 ), intent ( out ) :: &
Timing
logical, intent ( in ), optional :: &
UseDeviceOption
integer :: &
iV
real ( real64 ) :: &
Start
logical :: &
UseDevice
UseDevice = .true.
if ( present ( UseDeviceOption ) ) &
UseDevice = UseDeviceOption
if ( UseDevice ) then
!$OMP target enter data map ( to : A, B )
!$OMP target enter data map ( alloc: C )
end if
Start = omp_get_wtime ( )
!$OMP begin metadirective &
!$OMP when ( user = { condition ( UseDevice .EQV. .true. ) } &
!$OMP : target teams distribute )
!$OMP parallel do
do iV = 1, size ( A )
C ( iV ) = A ( iV ) + B ( iV )
end do
!$OMP end parallel do
!$OMP end metadirective
Timing = omp_get_wtime ( ) - Start
if ( UseDevice ) then
!$OMP target exit data map ( from : C )
!$OMP target exit data map ( delete: A, B, C )
end if
end subroutine ComputeAndTimeVectorAddition
!$OMP parallel do
do iV = 1, size ( A )
C ( iV ) = A ( iV ) + B ( iV )
end do
end program OpenMP_metadirective_target_test
end program OpenMP_metadirective_user_condition_target_test
Supports Markdown
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