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'.
6 ! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
18 real(kind(1.d0)) :: x
\r
19 real(kind(1.d0)) :: y
\r
20 real(kind(1.d0)) :: z
\r
24 ! ----- Constructors -----
\r
26 ! Public default constructor
\r
27 elemental function vector_(x,y,z)
\r
28 type(vector) :: vector_
\r
29 real(kind(1.d0)), intent(in) :: x, y, z
\r
31 vector_ = vector(x,y,z)
\r
33 end function vector_
\r
35 end module class_vector
\r
37 module class_dimensions
\r
42 public :: dimensions
\r
53 end module class_dimensions
\r
60 interface lin_interp
\r
61 function lin_interp_s(f1,f2,fac)
\r
62 real(kind(1.d0)) :: lin_interp_s
\r
63 real(kind(1.d0)), intent(in) :: f1, f2
\r
64 real(kind(1.d0)), intent(in) :: fac
\r
65 end function lin_interp_s
\r
67 function lin_interp_v(f1,f2,fac)
\r
69 type(vector) :: lin_interp_v
\r
70 type(vector), intent(in) :: f1, f2
\r
71 real(kind(1.d0)), intent(in) :: fac
\r
72 end function lin_interp_v
\r
77 subroutine pwl_deriv_x_s(dydx,x,y_data,x_data)
\r
78 real(kind(1.d0)), intent(out) :: dydx
\r
79 real(kind(1.d0)), intent(in) :: x
\r
80 real(kind(1.d0)), intent(in) :: y_data(:)
\r
81 real(kind(1.d0)), intent(in) :: x_data(:)
\r
82 end subroutine pwl_deriv_x_s
\r
84 subroutine pwl_deriv_x_v(dydx,x,y_data,x_data)
\r
85 real(kind(1.d0)), intent(out) :: dydx(:)
\r
86 real(kind(1.d0)), intent(in) :: x
\r
87 real(kind(1.d0)), intent(in) :: y_data(:,:)
\r
88 real(kind(1.d0)), intent(in) :: x_data(:)
\r
89 end subroutine pwl_deriv_x_v
\r
91 subroutine pwl_deriv_x_vec(dydx,x,y_data,x_data)
\r
93 type(vector), intent(out) :: dydx
\r
94 real(kind(1.d0)), intent(in) :: x
\r
95 type(vector), intent(in) :: y_data(:)
\r
96 real(kind(1.d0)), intent(in) :: x_data(:)
\r
97 end subroutine pwl_deriv_x_vec
\r
100 end module tools_math
\r
102 module class_motion
\r
110 public :: get_displacement, get_velocity
\r
114 integer :: surface_motion
\r
115 integer :: vertex_motion
\r
118 real(kind(1.d0)), allocatable :: law_x(:)
\r
119 type(vector), allocatable :: law_y(:)
\r
125 function get_displacement(mot,x1,x2)
\r
128 type(vector) :: get_displacement
\r
129 type(motion), intent(in) :: mot
\r
130 real(kind(1.d0)), intent(in) :: x1, x2
\r
132 integer :: i1, i2, i3, i4
\r
133 type(vector) :: p1, p2, v_A, v_B, v_C, v_D
\r
134 type(vector) :: i_trap_1, i_trap_2, i_trap_3
\r
136 get_displacement = vector_(0.d0,0.d0,0.d0)
\r
138 end function get_displacement
\r
141 function get_velocity(mot,x)
\r
144 type(vector) :: get_velocity
\r
145 type(motion), intent(in) :: mot
\r
146 real(kind(1.d0)), intent(in) :: x
\r
150 get_velocity = vector_(0.d0,0.d0,0.d0)
\r
152 end function get_velocity
\r
156 end module class_motion
\r
158 module class_bc_math
\r
169 real(kind(1.d0)), allocatable :: a(:)
\r
170 real(kind(1.d0)), allocatable :: b(:)
\r
171 real(kind(1.d0)), allocatable :: c(:)
\r
175 end module class_bc_math
\r
186 public :: get_abc, &
\r
187 & get_displacement, get_velocity
\r
192 type(motion) :: mot
\r
193 type(bc_math), pointer :: math => null()
\r
197 interface get_displacement
\r
198 module procedure get_displacement, get_bc_motion_displacement
\r
201 interface get_velocity
\r
202 module procedure get_velocity, get_bc_motion_velocity
\r
206 module procedure get_abc_s, get_abc_v
\r
212 subroutine get_abc_s(bc,dim,id,a,b,c)
\r
213 use class_dimensions
\r
215 type(bc_poly), intent(in) :: bc
\r
216 type(dimensions), intent(in) :: dim
\r
217 integer, intent(out) :: id
\r
218 real(kind(1.d0)), intent(inout) :: a(:)
\r
219 real(kind(1.d0)), intent(inout) :: b(:)
\r
220 real(kind(1.d0)), intent(inout) :: c(:)
\r
223 end subroutine get_abc_s
\r
226 subroutine get_abc_v(bc,dim,id,a,b,c)
\r
227 use class_dimensions
\r
230 type(bc_poly), intent(in) :: bc
\r
231 type(dimensions), intent(in) :: dim
\r
232 integer, intent(out) :: id
\r
233 real(kind(1.d0)), intent(inout) :: a(:)
\r
234 real(kind(1.d0)), intent(inout) :: b(:)
\r
235 type(vector), intent(inout) :: c(:)
\r
238 end subroutine get_abc_v
\r
242 function get_bc_motion_displacement(bc,x1,x2)result(res)
\r
244 type(vector) :: res
\r
245 type(bc_poly), intent(in) :: bc
\r
246 real(kind(1.d0)), intent(in) :: x1, x2
\r
248 res = get_displacement(bc%mot,x1,x2)
\r
250 end function get_bc_motion_displacement
\r
253 function get_bc_motion_velocity(bc,x)result(res)
\r
255 type(vector) :: res
\r
256 type(bc_poly), intent(in) :: bc
\r
257 real(kind(1.d0)), intent(in) :: x
\r
259 res = get_velocity(bc%mot,x)
\r
261 end function get_bc_motion_velocity
\r
264 end module class_bc
\r
266 module tools_mesh_basics
\r
271 function geom_tet_center(v1,v2,v3,v4)
\r
273 type(vector) :: geom_tet_center
\r
274 type(vector), intent(in) :: v1, v2, v3, v4
\r
275 end function geom_tet_center
\r
279 end module tools_mesh_basics
\r
282 subroutine smooth_mesh
\r
286 use tools_mesh_basics
\r
290 type(vector) :: new_pos ! the new vertex position, after smoothing
\r
292 end subroutine smooth_mesh
\r
293 ! { dg-final { cleanup-modules "class_vector class_dimensions tools_math" } }
294 ! { dg-final { cleanup-modules "class_motion class_bc_math class_bc tools_mesh_basics" } }