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