| ! { 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 |