1! { dg-do compile }
2
3module m
4  integer :: i
5end module m
6subroutine f1
7  type t
8    integer :: i
9  end type t
10  interface
11    integer function f3 (a, b)
12      !$omp declare simd (f3) uniform (a)
13      use m
14      import :: t
15      implicit none
16      type (t) :: a
17      integer :: b
18    end function f3
19  end interface
20  interface
21    integer function f4 (a, b)
22      use m
23      !$omp declare simd (f4) uniform (a)
24      import :: t
25      implicit none
26      type (t) :: a
27      integer :: b
28    end function f4
29  end interface
30  interface
31    integer function f5 (a, b)
32      use m
33      import :: t
34      !$omp declare simd (f5) uniform (a)
35      implicit none
36      type (t) :: a
37      integer :: b
38    end function f5
39  end interface
40  interface
41    integer function f6 (a, b)
42      use m
43      import :: t
44      implicit none
45      !$omp declare simd (f6) uniform (a)
46      type (t) :: a
47      integer :: b
48    end function f6
49  end interface
50  interface
51    integer function f7 (a, b)
52      use m
53      import :: t
54      implicit none
55      type (t) :: a
56      !$omp declare simd (f7) uniform (a)
57      integer :: b
58    end function f7
59  end interface
60  call f2
61contains
62  subroutine f2
63    !$omp threadprivate (t1)
64    use m
65    !$omp threadprivate (t2)
66    implicit none
67    !$omp threadprivate (t3)
68    integer, save :: t1, t2, t3, t4
69    !$omp threadprivate (t4)
70    t1 = 1; t2 = 2; t3 = 3; t4 = 4
71  end subroutine f2
72  subroutine f8
73    !$omp declare reduction (f8_1:real:omp_out = omp_out + omp_in)
74    use m
75    !$omp declare reduction (f8_2:real:omp_out = omp_out + omp_in)
76    implicit none
77    !$omp declare reduction (f8_3:real:omp_out = omp_out + omp_in)
78    integer :: j
79    !$omp declare reduction (f8_4:real:omp_out = omp_out + omp_in)
80  end subroutine f8
81  subroutine f9
82    !$omp declare target (f9_1)
83    use m
84    !$omp declare target (f9_2)
85    implicit none
86    !$omp declare target (f9_3)
87    !$omp declare target
88    integer, save :: f9_1, f9_2, f9_3, f9_4
89    !$omp declare target (f9_4)
90    f9_1 = 1; f9_2 = 2; f9_3 = 3; f9_4 = 4
91  end subroutine f9
92end subroutine f1
93