OpenMP_beginend_metadirective_target_teams_distribute.f90 1.38 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
!-- Check if using begin/end metadirective with static selector for 
!   target executes on device and produces correct results.
!   This should pass on "ibm", fail elsewhere.

program OpenMP_metadirective_target_test

  use omp_lib
  use iso_fortran_env
  
  implicit none
  
  integer :: &
    iV
  real ( real64 ), dimension ( : ), allocatable :: &
    A, B, C, &
    C_Ref
  character ( 1 ) :: &
    ibm, cray
    
  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
  
  !$OMP target enter data map ( to: A, B, C )
  
  !-- FIXME: multiple selector seems to confuse IBM XL
  !; $OMP begin metadirective &
  !; $OMP   when ( implementation = { vendor(ibm) } &
  !; $OMP            : target ) &
  !; $OMP   when ( implementation = { vendor(cray) } &
  !; $OMP            : target )

  !$OMP begin metadirective &
  !$OMP   when ( implementation = { vendor(ibm) } &
  !$OMP            : target )

  !$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
  
  !$OMP target update from ( C )

  if ( all ( C == C_Ref ) ) then
    print*, 'PASSED'
  else
    print*, 'FAILED'
  end if

  
end program OpenMP_metadirective_target_test