Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Budiardja, Reuben
Fortran Frontier
Commits
c4ebc929
Commit
c4ebc929
authored
Aug 11, 2021
by
Budiardja, Reuben
Browse files
Expanded test with more checking. Still not working due to compiler limitation.
parent
daf686a5
Changes
1
Hide whitespace changes
Inline
Side-by-side
Cases/Composite/OpenMP_Metadirective/OpenMP_metadirective_user_condition_target.f90
View file @
c4ebc929
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
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment