| ! { dg-do compile } |
| ! Tests the fix for PR37274 a regression in which the derived type, |
| ! 'vector' of the function results contained in 'class_motion' is |
| ! private and is incorrectly detected to be ambiguous in 'smooth_mesh'. |
| ! |
| ! Contributed by Salvatore Filippone <sfilippone@uniroma2.it> |
| ! |
| module class_vector
|
|
|
| implicit none
|
|
|
| private ! Default
|
| public :: vector
|
| public :: vector_
|
|
|
| type vector
|
| private
|
| real(kind(1.d0)) :: x
|
| real(kind(1.d0)) :: y
|
| real(kind(1.d0)) :: z
|
| end type vector
|
|
|
| contains
|
| ! ----- Constructors -----
|
|
|
| ! Public default constructor
|
| elemental function vector_(x,y,z)
|
| type(vector) :: vector_
|
| real(kind(1.d0)), intent(in) :: x, y, z
|
|
|
| vector_ = vector(x,y,z)
|
|
|
| end function vector_
|
|
|
| end module class_vector
|
|
|
| module class_dimensions
|
|
|
| implicit none
|
|
|
| private ! Default
|
| public :: dimensions
|
|
|
| type dimensions
|
| private
|
| integer :: l
|
| integer :: m
|
| integer :: t
|
| integer :: theta
|
| end type dimensions
|
|
|
|
|
| end module class_dimensions
|
|
|
| module tools_math
|
|
|
| implicit none
|
|
|
|
|
| interface lin_interp
|
| function lin_interp_s(f1,f2,fac)
|
| real(kind(1.d0)) :: lin_interp_s
|
| real(kind(1.d0)), intent(in) :: f1, f2
|
| real(kind(1.d0)), intent(in) :: fac
|
| end function lin_interp_s
|
|
|
| function lin_interp_v(f1,f2,fac)
|
| use class_vector
|
| type(vector) :: lin_interp_v
|
| type(vector), intent(in) :: f1, f2
|
| real(kind(1.d0)), intent(in) :: fac
|
| end function lin_interp_v
|
| end interface
|
|
|
|
|
| interface pwl_deriv
|
| subroutine pwl_deriv_x_s(dydx,x,y_data,x_data)
|
| real(kind(1.d0)), intent(out) :: dydx
|
| real(kind(1.d0)), intent(in) :: x
|
| real(kind(1.d0)), intent(in) :: y_data(:)
|
| real(kind(1.d0)), intent(in) :: x_data(:)
|
| end subroutine pwl_deriv_x_s
|
|
|
| subroutine pwl_deriv_x_v(dydx,x,y_data,x_data)
|
| real(kind(1.d0)), intent(out) :: dydx(:)
|
| real(kind(1.d0)), intent(in) :: x
|
| real(kind(1.d0)), intent(in) :: y_data(:,:)
|
| real(kind(1.d0)), intent(in) :: x_data(:)
|
| end subroutine pwl_deriv_x_v
|
|
|
| subroutine pwl_deriv_x_vec(dydx,x,y_data,x_data)
|
| use class_vector
|
| type(vector), intent(out) :: dydx
|
| real(kind(1.d0)), intent(in) :: x
|
| type(vector), intent(in) :: y_data(:)
|
| real(kind(1.d0)), intent(in) :: x_data(:)
|
| end subroutine pwl_deriv_x_vec
|
| end interface
|
|
|
| end module tools_math
|
|
|
| module class_motion
|
|
|
| use class_vector
|
|
|
| implicit none
|
|
|
| private
|
| public :: motion
|
| public :: get_displacement, get_velocity
|
|
|
| type motion
|
| private
|
| integer :: surface_motion
|
| integer :: vertex_motion
|
| !
|
| integer :: iml
|
| real(kind(1.d0)), allocatable :: law_x(:)
|
| type(vector), allocatable :: law_y(:)
|
| end type motion
|
|
|
| contains
|
|
|
|
|
| function get_displacement(mot,x1,x2)
|
| use tools_math
|
|
|
| type(vector) :: get_displacement
|
| type(motion), intent(in) :: mot
|
| real(kind(1.d0)), intent(in) :: x1, x2
|
| !
|
| integer :: i1, i2, i3, i4
|
| type(vector) :: p1, p2, v_A, v_B, v_C, v_D
|
| type(vector) :: i_trap_1, i_trap_2, i_trap_3
|
|
|
| get_displacement = vector_(0.d0,0.d0,0.d0)
|
|
|
| end function get_displacement
|
|
|
|
|
| function get_velocity(mot,x)
|
| use tools_math
|
|
|
| type(vector) :: get_velocity
|
| type(motion), intent(in) :: mot
|
| real(kind(1.d0)), intent(in) :: x
|
| !
|
| type(vector) :: v
|
|
|
| get_velocity = vector_(0.d0,0.d0,0.d0)
|
|
|
| end function get_velocity
|
|
|
|
|
|
|
| end module class_motion
|
|
|
| module class_bc_math
|
|
|
| implicit none
|
|
|
| private
|
| public :: bc_math
|
|
|
| type bc_math
|
| private
|
| integer :: id
|
| integer :: nbf
|
| real(kind(1.d0)), allocatable :: a(:)
|
| real(kind(1.d0)), allocatable :: b(:)
|
| real(kind(1.d0)), allocatable :: c(:)
|
| end type bc_math
|
|
|
|
|
| end module class_bc_math
|
|
|
| module class_bc
|
|
|
| use class_bc_math
|
| use class_motion
|
|
|
| implicit none
|
|
|
| private
|
| public :: bc_poly
|
| public :: get_abc, &
|
| & get_displacement, get_velocity
|
|
|
| type bc_poly
|
| private
|
| integer :: id
|
| type(motion) :: mot
|
| type(bc_math), pointer :: math => null()
|
| end type bc_poly
|
|
|
|
|
| interface get_displacement
|
| module procedure get_displacement, get_bc_motion_displacement
|
| end interface
|
|
|
| interface get_velocity
|
| module procedure get_velocity, get_bc_motion_velocity
|
| end interface
|
|
|
| interface get_abc
|
| module procedure get_abc_s, get_abc_v
|
| end interface
|
|
|
| contains
|
|
|
|
|
| subroutine get_abc_s(bc,dim,id,a,b,c)
|
| use class_dimensions
|
|
|
| type(bc_poly), intent(in) :: bc
|
| type(dimensions), intent(in) :: dim
|
| integer, intent(out) :: id
|
| real(kind(1.d0)), intent(inout) :: a(:)
|
| real(kind(1.d0)), intent(inout) :: b(:)
|
| real(kind(1.d0)), intent(inout) :: c(:)
|
|
|
|
|
| end subroutine get_abc_s
|
|
|
|
|
| subroutine get_abc_v(bc,dim,id,a,b,c)
|
| use class_dimensions
|
| use class_vector
|
|
|
| type(bc_poly), intent(in) :: bc
|
| type(dimensions), intent(in) :: dim
|
| integer, intent(out) :: id
|
| real(kind(1.d0)), intent(inout) :: a(:)
|
| real(kind(1.d0)), intent(inout) :: b(:)
|
| type(vector), intent(inout) :: c(:)
|
|
|
|
|
| end subroutine get_abc_v
|
|
|
|
|
|
|
| function get_bc_motion_displacement(bc,x1,x2)result(res)
|
| use class_vector
|
| type(vector) :: res
|
| type(bc_poly), intent(in) :: bc
|
| real(kind(1.d0)), intent(in) :: x1, x2
|
|
|
| res = get_displacement(bc%mot,x1,x2)
|
|
|
| end function get_bc_motion_displacement
|
|
|
|
|
| function get_bc_motion_velocity(bc,x)result(res)
|
| use class_vector
|
| type(vector) :: res
|
| type(bc_poly), intent(in) :: bc
|
| real(kind(1.d0)), intent(in) :: x
|
|
|
| res = get_velocity(bc%mot,x)
|
|
|
| end function get_bc_motion_velocity
|
|
|
|
|
| end module class_bc
|
|
|
| module tools_mesh_basics
|
|
|
| implicit none
|
|
|
| interface
|
| function geom_tet_center(v1,v2,v3,v4)
|
| use class_vector
|
| type(vector) :: geom_tet_center
|
| type(vector), intent(in) :: v1, v2, v3, v4
|
| end function geom_tet_center
|
| end interface
|
|
|
|
|
| end module tools_mesh_basics
|
|
|
|
|
| subroutine smooth_mesh
|
|
|
| use class_bc
|
| use class_vector
|
| use tools_mesh_basics
|
|
|
| implicit none
|
|
|
| type(vector) :: new_pos ! the new vertex position, after smoothing
|
|
|
| end subroutine smooth_mesh
|
