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>
24 ! ----- Constructors -----
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
31 vector_
= vector(x
,y
,z
)
35 end module class_vector
37 module class_dimensions
53 end module class_dimensions
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
67 function lin_interp_v(f1
,f2
,fac
)
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
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
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
91 subroutine pwl_deriv_x_vec(dydx
,x
,y_data
,x_data
)
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
100 end module tools_math
110 public
:: get_displacement
, get_velocity
114 integer :: surface_motion
115 integer :: vertex_motion
118 real(kind(1.d0
)), allocatable
:: law_x(:)
119 type(vector
), allocatable
:: law_y(:)
125 function get_displacement(mot
,x1
,x2
)
128 type(vector
) :: get_displacement
129 type(motion
), intent(in
) :: mot
130 real(kind(1.d0
)), intent(in
) :: x1
, x2
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
136 get_displacement
= vector_(0.d0
,0.d0
,0.d0
)
138 end function get_displacement
141 function get_velocity(mot
,x
)
144 type(vector
) :: get_velocity
145 type(motion
), intent(in
) :: mot
146 real(kind(1.d0
)), intent(in
) :: x
150 get_velocity
= vector_(0.d0
,0.d0
,0.d0
)
152 end function get_velocity
156 end module class_motion
169 real(kind(1.d0
)), allocatable
:: a(:)
170 real(kind(1.d0
)), allocatable
:: b(:)
171 real(kind(1.d0
)), allocatable
:: c(:)
175 end module class_bc_math
187 & get_displacement
, get_velocity
193 type(bc_math
), pointer :: math
=> null()
197 interface get_displacement
198 module procedure get_displacement
, get_bc_motion_displacement
201 interface get_velocity
202 module procedure get_velocity
, get_bc_motion_velocity
206 module procedure get_abc_s
, get_abc_v
212 subroutine get_abc_s(bc
,dim
,id
,a
,b
,c
)
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(:)
223 end subroutine get_abc_s
226 subroutine get_abc_v(bc
,dim
,id
,a
,b
,c
)
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(:)
238 end subroutine get_abc_v
242 function get_bc_motion_displacement(bc
,x1
,x2
)result(res
)
245 type(bc_poly
), intent(in
) :: bc
246 real(kind(1.d0
)), intent(in
) :: x1
, x2
248 res
= get_displacement(bc
%mot
,x1
,x2
)
250 end function get_bc_motion_displacement
253 function get_bc_motion_velocity(bc
,x
)result(res
)
256 type(bc_poly
), intent(in
) :: bc
257 real(kind(1.d0
)), intent(in
) :: x
259 res
= get_velocity(bc
%mot
,x
)
261 end function get_bc_motion_velocity
266 module tools_mesh_basics
271 function geom_tet_center(v1
,v2
,v3
,v4
)
273 type(vector
) :: geom_tet_center
274 type(vector
), intent(in
) :: v1
, v2
, v3
, v4
275 end function geom_tet_center
279 end module tools_mesh_basics
282 subroutine smooth_mesh
286 use tools_mesh_basics
290 type(vector
) :: new_pos
! the new vertex position, after smoothing
292 end subroutine smooth_mesh