1module main
2  implicit none
3
4  interface
5    integer function foo (a, b, c)
6      integer, intent(in) :: a, b
7      integer, intent(inout) :: c
8    end function
9
10    integer function bar (a, b, c)
11      integer, intent(in) :: a, b
12      integer, intent(inout) :: c
13    end function
14
15    integer function baz (a, b, c)
16      integer, intent(in) :: a, b
17      integer, intent(inout) :: c
18
19      !$omp declare variant (foo) &
20      !$omp & match (construct={parallel,do}, &
21      !$omp & device={isa(avx512f,avx512vl),kind(host,cpu)}, &
22      !$omp & implementation={vendor(score(0):gnu),unified_shared_memory}, &
23      !$omp & user={condition(score(0):0)})
24      !$omp declare variant (bar) &
25      !$omp & match (device={arch(x86_64,powerpc64),isa(avx512f,popcntb)}, &
26      !$omp & implementation={atomic_default_mem_order(seq_cst),made_up_selector("foo", 13, "bar")}, &
27      !$omp & user={condition(3-3)})
28    end function
29
30    subroutine quux
31    end subroutine quux
32
33    integer function baz3 (x, y, z)
34      integer, intent(in) :: x, y
35      integer, intent(inout) :: z
36
37      !$omp declare variant (bar) match &
38      !$omp & (implementation={atomic_default_mem_order(score(3): acq_rel)})
39    end function
40  end interface
41contains
42  integer function qux ()
43    integer :: i = 3
44
45    qux = baz (1, 2, i)
46  end function
47
48  subroutine corge
49    integer :: i
50    !$omp declare variant (quux) match (construct={parallel,do})
51
52    interface
53      subroutine waldo (x)
54        integer, intent(in) :: x
55      end subroutine
56    end interface
57
58    call waldo (5)
59    !$omp parallel do
60      do i = 1, 3
61	call waldo (6)
62      end do
63    !$omp end parallel do
64
65    !$omp parallel
66      !$omp taskgroup
67	!$omp do
68	  do i = 1, 3
69	    call waldo (7)
70	  end do
71        !$omp end do
72      !$omp end taskgroup
73    !$omp end parallel
74
75    !$omp parallel
76      !$omp master
77        call waldo (8)
78      !$omp end master
79    !$omp end parallel
80  end subroutine
81
82  integer function baz2 (x, y, z)
83    integer, intent(in) :: x, y
84    integer, intent(inout) :: z
85
86    !$omp declare variant (bar) match &
87    !$omp & (implementation={atomic_default_mem_order(relaxed), &
88    !$omp &		   unified_address, unified_shared_memory, &
89    !$omp &		   dynamic_allocators, reverse_offload})
90
91    baz2 = x + y + z
92  end function
93end module
94