OpenMP_beginend_metadirective_user_condition_target.f90 1.5 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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
!-- Check if using begin/end metadirective with user condition for 
!   target executes on device and produces correct results.

program OpenMP_beginend_metadirective_user_condition_target

  use omp_lib
  use iso_fortran_env
  
  implicit none
  
  integer :: &
    iV
  real ( real64 ), dimension ( : ), allocatable :: &
    A, B, C, &
    C_Ref
  logical :: &
    UseDevice, &
    OnDevice 
    
  allocate ( A ( 1024 ) )
  allocate ( B ( 1024 ) )
  allocate ( C ( 1024 ) )
  
  call random_number ( A )
  call random_number ( B )
  call random_number ( C )
  allocate ( C_Ref, source = C )
  
  C_Ref = A + B
  
  OnDevice  = .false.
  UseDevice = .false.
  
  !$OMP target enter data map ( to: A, B, C )
  
  !-- !$OMP begin metadirective &
  !-- !$OMP   when ( user = { condition ( UseDevice .EQV. .true. ) } &
  !-- !$OMP            : target map ( from: OnDevice ) )
  OnDevice = .not. omp_is_initial_device ( )

  !$OMP teams distribute parallel do
  do iV = 1, size ( A )
    C ( iV ) = A ( iV ) + B ( iV )
  end do
  !$OMP end teams distribute parallel do
  
  !-- !$OMP end metadirective

  if ( OnDevice ) then
    print*, 'Run on device   : TRUE'
  else 
    print*, 'Run on device   : FALSE'
  end if
  
  if ( UseDevice ) then
    !$OMP target update from ( C )
  end if
  
  if ( all ( C == C_Ref ) ) then
    print*, 'Correct results : PASSED'
  else
    print*, 'Correct results : FAILED'
  end if
  
  !$OMP target exit data map ( delete: A, B, C )

  
end program OpenMP_beginend_metadirective_user_condition_target