1! { dg-do compile }
2! Tests the fix for PR37274 a regression in which the derived type,
3! 'vector' of the function results contained in 'class_motion' is
4! private and is incorrectly detected to be ambiguous in 'smooth_mesh'.
5!
6! Contributed by Salvatore Filippone  <sfilippone@uniroma2.it>
7!
8module class_vector
9
10  implicit none
11
12  private ! Default
13  public :: vector
14  public :: vector_
15
16  type vector
17     private
18     real(kind(1.d0)) :: x
19     real(kind(1.d0)) :: y
20     real(kind(1.d0)) :: z
21  end type vector
22
23contains
24  ! ----- Constructors -----
25
26  ! Public default constructor
27  elemental function vector_(x,y,z)
28    type(vector) :: vector_
29    real(kind(1.d0)), intent(in) :: x, y, z
30
31    vector_ = vector(x,y,z)
32
33  end function vector_
34
35end module class_vector
36
37module class_dimensions
38
39  implicit none
40
41  private ! Default
42  public :: dimensions
43
44  type dimensions
45     private
46     integer :: l
47     integer :: m
48     integer :: t
49     integer :: theta
50  end type dimensions
51
52
53end module class_dimensions
54
55module tools_math
56
57  implicit none
58
59
60  interface lin_interp
61     function lin_interp_s(f1,f2,fac)
62       real(kind(1.d0)) :: lin_interp_s
63       real(kind(1.d0)), intent(in) :: f1, f2
64       real(kind(1.d0)), intent(in) :: fac
65     end function lin_interp_s
66
67     function lin_interp_v(f1,f2,fac)
68       use class_vector
69       type(vector) :: lin_interp_v
70       type(vector),     intent(in) :: f1, f2
71       real(kind(1.d0)), intent(in) :: fac
72     end function lin_interp_v
73  end interface
74
75
76  interface pwl_deriv
77     subroutine pwl_deriv_x_s(dydx,x,y_data,x_data)
78       real(kind(1.d0)), intent(out) :: dydx
79       real(kind(1.d0)), intent(in) :: x
80       real(kind(1.d0)), intent(in) :: y_data(:)
81       real(kind(1.d0)), intent(in) :: x_data(:)
82     end subroutine pwl_deriv_x_s
83
84     subroutine pwl_deriv_x_v(dydx,x,y_data,x_data)
85       real(kind(1.d0)), intent(out) :: dydx(:)
86       real(kind(1.d0)), intent(in) :: x
87       real(kind(1.d0)), intent(in) :: y_data(:,:)
88       real(kind(1.d0)), intent(in) :: x_data(:)
89     end subroutine pwl_deriv_x_v
90
91     subroutine pwl_deriv_x_vec(dydx,x,y_data,x_data)
92       use class_vector
93       type(vector), intent(out) :: dydx
94       real(kind(1.d0)), intent(in) :: x
95       type(vector), intent(in) :: y_data(:)
96       real(kind(1.d0)), intent(in) :: x_data(:)
97     end subroutine pwl_deriv_x_vec
98  end interface
99
100end module tools_math
101
102module class_motion
103
104  use class_vector
105
106  implicit none
107
108  private
109  public :: motion
110  public :: get_displacement, get_velocity
111
112  type motion
113     private
114     integer :: surface_motion
115     integer :: vertex_motion
116     !
117     integer :: iml
118     real(kind(1.d0)), allocatable :: law_x(:)
119     type(vector), allocatable :: law_y(:)
120  end type motion
121
122contains
123
124
125  function get_displacement(mot,x1,x2)
126    use tools_math
127
128    type(vector) :: get_displacement
129    type(motion), intent(in) :: mot
130    real(kind(1.d0)), intent(in) :: x1, x2
131    !
132    integer :: i1, i2, i3, i4
133    type(vector) :: p1, p2, v_A, v_B, v_C, v_D
134    type(vector) :: i_trap_1, i_trap_2, i_trap_3
135
136    get_displacement = vector_(0.d0,0.d0,0.d0)
137
138  end function get_displacement
139
140
141  function get_velocity(mot,x)
142    use tools_math
143
144    type(vector) :: get_velocity
145    type(motion), intent(in) :: mot
146    real(kind(1.d0)), intent(in) :: x
147    !
148    type(vector) :: v
149
150    get_velocity = vector_(0.d0,0.d0,0.d0)
151
152  end function get_velocity
153
154
155
156end module class_motion
157
158module class_bc_math
159
160  implicit none
161
162  private
163  public :: bc_math
164
165  type bc_math
166     private
167     integer :: id
168     integer :: nbf
169     real(kind(1.d0)), allocatable :: a(:)
170     real(kind(1.d0)), allocatable :: b(:)
171     real(kind(1.d0)), allocatable :: c(:)
172  end type bc_math
173
174
175end module class_bc_math
176
177module class_bc
178
179  use class_bc_math
180  use class_motion
181
182  implicit none
183
184  private
185  public :: bc_poly
186  public :: get_abc, &
187       &    get_displacement, get_velocity
188
189  type bc_poly
190     private
191     integer :: id
192     type(motion) :: mot
193     type(bc_math), pointer :: math => null()
194  end type bc_poly
195
196
197  interface get_displacement
198     module procedure get_displacement, get_bc_motion_displacement
199  end interface
200
201  interface get_velocity
202     module procedure get_velocity, get_bc_motion_velocity
203  end interface
204
205  interface get_abc
206     module procedure get_abc_s, get_abc_v
207  end interface
208
209contains
210
211
212  subroutine get_abc_s(bc,dim,id,a,b,c)
213    use class_dimensions
214
215    type(bc_poly), intent(in) :: bc
216    type(dimensions), intent(in) :: dim
217    integer, intent(out) :: id
218    real(kind(1.d0)), intent(inout) :: a(:)
219    real(kind(1.d0)), intent(inout) :: b(:)
220    real(kind(1.d0)), intent(inout) :: c(:)
221
222
223  end subroutine get_abc_s
224
225
226  subroutine get_abc_v(bc,dim,id,a,b,c)
227    use class_dimensions
228    use class_vector
229
230    type(bc_poly), intent(in) :: bc
231    type(dimensions), intent(in) :: dim
232    integer, intent(out) :: id
233    real(kind(1.d0)), intent(inout) :: a(:)
234    real(kind(1.d0)), intent(inout) :: b(:)
235    type(vector),     intent(inout) :: c(:)
236
237
238  end subroutine get_abc_v
239
240
241
242  function get_bc_motion_displacement(bc,x1,x2)result(res)
243    use class_vector
244    type(vector) :: res
245    type(bc_poly), intent(in) :: bc
246    real(kind(1.d0)), intent(in) :: x1, x2
247
248    res = get_displacement(bc%mot,x1,x2)
249
250  end function get_bc_motion_displacement
251
252
253  function get_bc_motion_velocity(bc,x)result(res)
254    use class_vector
255    type(vector) :: res
256    type(bc_poly), intent(in) :: bc
257    real(kind(1.d0)), intent(in) :: x
258
259    res = get_velocity(bc%mot,x)
260
261  end function get_bc_motion_velocity
262
263
264end module class_bc
265
266module tools_mesh_basics
267
268  implicit none
269
270  interface
271     function geom_tet_center(v1,v2,v3,v4)
272       use class_vector
273       type(vector) :: geom_tet_center
274       type(vector), intent(in) :: v1, v2, v3, v4
275     end function geom_tet_center
276  end interface
277
278
279end module tools_mesh_basics
280
281
282subroutine smooth_mesh
283
284  use class_bc
285  use class_vector
286  use tools_mesh_basics
287
288  implicit none
289
290  type(vector) :: new_pos  ! the new vertex position, after smoothing
291
292end subroutine smooth_mesh
293