OpenMP_metadirective_user_condition_target.f90 3.26 KB
Newer Older
1
program OpenMP_metadirective_user_condition_target_test
2
3
4
5

  use omp_lib
  use iso_fortran_env
  
6
7
8
  implicit none
  
  logical :: &
9
    UseDevice
10
11
  real ( real64 ) :: &
    Timing
12
  real ( real64 ), dimension ( : ), allocatable :: &
13
14
    A, B, C, &
    C_Ref
15
    
16
17
18
19
20
21
22
23
24
25
26
27
  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*, ''
28
    
29
30
31
32
33
  
  allocate ( A ( 1024*10 ) )
  allocate ( B ( 1024*10 ) )
  allocate ( C ( 1024*10 ) )
  allocate ( C_Ref, source = C )
34
35
36
37
  
  call random_number ( A )
  call random_number ( B )
  
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
  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
135
136
  
  
137
end program OpenMP_metadirective_user_condition_target_test