51 character(len=25) :: FLUID_PNPN_KNOWN_BCS(13) = [character(len=25) :: &
58 "normal_outflow+dong", &
63 "user_velocity_pointwise", &
74 module subroutine pressure_bc_factory(object, scheme, json, coef, user)
75 class(bc_t),
pointer,
intent(inout) :: object
76 type(fluid_pnpn_t),
intent(in) :: scheme
77 type(json_file),
intent(inout) :: json
78 type(coef_t),
intent(in) :: coef
79 type(user_t),
intent(in) :: user
80 character(len=:),
allocatable :: type
82 integer,
allocatable :: zone_indices(:)
84 call json_get(json,
"type", type)
86 select case (trim(type))
87 case (
"outflow",
"normal_outflow")
88 allocate(zero_dirichlet_t::object)
90 case (
"outflow+dong",
"normal_outflow+dong")
93 case (
"user_pressure")
95 select type (obj => object)
97 obj%update => user%user_dirichlet_update
98 call json%add(
"field_name", scheme%p%name)
102 do i = 1,
size(fluid_pnpn_known_bcs)
103 if (trim(type) .eq. trim(fluid_pnpn_known_bcs(i)))
return
106 FLUID_PNPN_KNOWN_BCS)
109 call json_get(json,
"zone_indices", zone_indices)
110 call object%init(coef, json)
112 do i = 1,
size(zone_indices)
113 call object%mark_zone(coef%msh%labeled_zones(zone_indices(i)))
115 call object%finalize()
119 do i = 1,
size(zone_indices)
120 do j = 1, scheme%msh%nelv
121 do k = 1, 2 * scheme%msh%gdim
122 if (scheme%msh%facet_type(k,j) .eq. -zone_indices(i))
then
123 scheme%msh%facet_type(k, j) = 1
128 end subroutine pressure_bc_factory
136 module subroutine velocity_bc_factory(object, scheme, json, coef, user)
137 class(bc_t),
pointer,
intent(inout) :: object
138 type(fluid_pnpn_t),
intent(in) :: scheme
139 type(json_file),
intent(inout) :: json
140 type(coef_t),
intent(in) :: coef
141 type(user_t),
intent(in) :: user
142 character(len=:),
allocatable :: type
144 integer,
allocatable :: zone_indices(:)
146 call json_get(json,
"type", type)
148 select case (trim(type))
151 case (
"velocity_value")
154 allocate(zero_dirichlet_t::object)
155 case (
"normal_outflow",
"normal_outflow+dong")
157 case (
"blasius_profile")
159 case (
"shear_stress")
160 allocate(shear_stress_t::object)
162 allocate(wall_model_bc_t::object)
166 call json%add(
"nu", scheme%mu / scheme%rho)
168 case (
"user_velocity")
170 select type (obj => object)
172 obj%update => user%user_dirichlet_update
175 case (
"user_velocity_pointwise")
177 select type (obj => object)
179 call obj%set_eval(user%fluid_user_if)
184 do i = 1,
size(fluid_pnpn_known_bcs)
185 if (trim(type) .eq. trim(fluid_pnpn_known_bcs(i)))
return
188 FLUID_PNPN_KNOWN_BCS)
191 call json_get(json,
"zone_indices", zone_indices)
192 call object%init(coef, json)
193 do i = 1,
size(zone_indices)
194 call object%mark_zone(coef%msh%labeled_zones(zone_indices(i)))
196 call object%finalize()
199 if (trim(type) .ne.
"normal_outflow" .and. &
200 trim(type) .ne.
"normal_outflow+dong")
then
201 do i = 1,
size(zone_indices)
202 do j = 1, scheme%msh%nelv
203 do k = 1, 2 * scheme%msh%gdim
204 if (scheme%msh%facet_type(k,j) .eq. -zone_indices(i))
then
205 scheme%msh%facet_type(k, j) = 2
211 end subroutine velocity_bc_factory
213end submodule fluid_pnpn_bc_fctry
Abstract interface defining a user defined inflow condition (pointwise)
Defines a Blasius profile dirichlet condition.
Defines a dirichlet boundary condition.
Defines a dong outflow condition.
Defines inflow dirichlet conditions.
Defines user dirichlet condition for a scalar field.
Modular version of the Classic Nek5000 Pn/Pn formulation for fluids.
Defines inflow dirichlet conditions.
Dirichlet condition on axis aligned plane in the non normal direction.
Mixed Dirichlet-Neumann axis aligned symmetry plane.
Interfaces for user interaction with NEKO.
Defines inflow dirichlet conditions.
subroutine, public neko_type_error(base_type, wrong_type, known_types)
Reports an error allocating a type for a particular base pointer class.
Blasius profile for inlet (vector valued).
Generic Dirichlet boundary condition on .
Dong outflow condition Follows "A Convective-like Energy-Stable Open Boundary Condition for Simulati...
User defined dirichlet condition, for which the user can work with an entire field....
Extension of the user defined dirichlet condition field_dirichlet
Dirichlet condition for inlet (vector valued)
Dirichlet condition in non normal direction of a plane.
Mixed Dirichlet-Neumann symmetry plane condition.
User defined dirichlet condition for velocity.