Commit 4359a0bd authored by Budiardja, Reuben's avatar Budiardja, Reuben
Browse files

Added test case for duplicated code with metadirective.

parent 29763443
program OpenMP_metadirective_user_condition_target_test
use omp_lib
use iso_fortran_env
implicit none
logical :: &
UseDevice
real ( real64 ) :: &
Timing
real ( real64 ), dimension ( : ), allocatable :: &
A, B, C, &
C_Ref
print*, 'NumDevices :', omp_get_num_devices ( )
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*10 ) )
allocate ( B ( 1024*10 ) )
allocate ( C ( 1024*10 ) )
allocate ( C_Ref, source = C )
call random_number ( A )
call random_number ( B )
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
print*, 'Entering compute', UseDevice
if ( UseDevice ) then
!$OMP target enter data map ( to : A, B )
!$OMP target enter data map ( alloc: C )
end if
Start = omp_get_wtime ( )
print*, 'Entering loop 1'
!$OMP metadirective &
!$OMP when ( user = { condition ( UseDevice .EQV. .true. ) } &
!$OMP : target teams distribute parallel do )
do iV = 1, size ( A )
C ( iV ) = A ( iV ) + B ( iV )
end do
print*, 'Entering loop 2'
!$OMP metadirective &
!$OMP when ( user = { condition ( UseDevice .EQV. .false. ) } &
!$OMP : parallel do )
do iV = 1, size ( A )
C ( iV ) = A ( iV ) + B ( iV )
end 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
end program OpenMP_metadirective_user_condition_target_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