38 use gather_scatter,
only: gs_t, gs_op_min, gs_op_max
39 use neko_config,
only: neko_bcknd_device
40 use num_types,
only: rp, i8
42 use field,
only: field_t
43 use space,
only: space_t, gll, gl
44 use dofmap,
only: dofmap_t
45 use krylov,
only: ksp_t, krylov_solver_factory, ksp_max_iter
46 use coefs,
only: coef_t
47 use jacobi,
only: jacobi_t
48 use sx_jacobi,
only: sx_jacobi_t
49 use device_jacobi,
only: device_jacobi_t
50 use hsmg,
only: hsmg_t
51 use phmg,
only: phmg_t
52 use precon,
only: pc_t, precon_factory, precon_destroy
53 use fluid_stats,
only: fluid_stats_t
55 use bc_list,
only: bc_list_t
56 use mesh,
only: mesh_t, neko_msh_max_zlbls, neko_msh_max_zlbl_len
57 use operators,
only: cfl
58 use logger,
only: neko_log, log_size, neko_log_verbose
59 use registry,
only: neko_registry
60 use json_utils,
only: json_get, json_get_or_default
61 use json_module,
only: json_file
62 use user_intf,
only: user_t, dummy_user_material_properties, &
63 user_material_properties_intf
64 use utils,
only: neko_error
65 use time_state,
only: time_state_t
68 use device_math,
only: device_cfill, device_add2s2
69 use field_math,
only: field_cfill, field_add2s2, field_addcol3
72 use device,
only : device_event_sync, glb_cmd_event, device_to_host, &
82 class(ksp_t),
allocatable :: ksp_vel
83 class(ksp_t),
allocatable :: ksp_prs
84 class(pc_t),
allocatable :: pc_vel
85 class(pc_t),
allocatable :: pc_prs
86 integer :: vel_projection_dim
87 integer :: pr_projection_dim
88 integer :: vel_projection_activ_step
89 integer :: pr_projection_activ_step
90 logical :: strict_convergence
93 type(field_t),
pointer :: u_adj_e => null()
94 type(field_t),
pointer :: v_adj_e => null()
95 type(field_t),
pointer :: w_adj_e => null()
97 type(fluid_stats_t) :: stats
98 logical :: forced_flow_rate = .false.
101 character(len=:),
allocatable :: nut_field_name
104 integer(kind=i8) :: glb_n_points
106 integer(kind=i8) :: glb_unique_points
110 procedure, pass(this) :: scheme_free => adjoint_fluid_scheme_free
112 procedure, pass(this) :: validate => adjoint_fluid_scheme_validate
114 procedure, pass(this) :: bc_apply_vel => adjoint_fluid_scheme_bc_apply_vel
116 procedure, pass(this) :: bc_apply_prs => adjoint_fluid_scheme_bc_apply_prs
118 procedure, pass(this) :: compute_cfl => adjoint_compute_cfl
120 procedure, pass(this) :: set_material_properties => &
121 adjoint_fluid_scheme_set_material_properties
124 procedure, pass(this) :: update_material_properties => &
125 adjoint_fluid_scheme_update_material_properties
127 procedure,
nopass :: solver_factory => adjoint_fluid_scheme_solver_factory
129 procedure, pass(this) :: precon_factory_ => &
130 adjoint_fluid_scheme_precon_factory
135 module subroutine adjoint_fluid_scheme_factory(object, type_name)
137 character(len=*) :: type_name
138 end subroutine adjoint_fluid_scheme_factory
141 public :: adjoint_fluid_scheme_incompressible_t, adjoint_fluid_scheme_factory
146 subroutine adjoint_fluid_scheme_init_base(this, msh, lx, params, scheme, &
148 class(adjoint_fluid_scheme_incompressible_t),
target,
intent(inout) :: this
149 type(mesh_t),
target,
intent(inout) :: msh
150 integer,
intent(in) :: lx
151 character(len=*),
intent(in) :: scheme
152 type(json_file),
target,
intent(inout) :: params
153 type(user_t),
target,
intent(in) :: user
154 logical,
intent(in) :: kspv_init
155 character(len=LOG_SIZE) :: log_buf
156 real(kind=rp) :: real_val
157 logical :: logical_val
158 integer :: integer_val
159 character(len=:),
allocatable :: string_val1, string_val2
160 character(len=:),
allocatable :: json_key
161 type(json_file) :: json_subdict
171 lxd = (3 * (lx + 1)) / 2
172 if (msh%gdim .eq. 2)
then
173 call this%Xh%init(gll, lx, lx)
175 call this%Xh%init(gll, lx, lx, lx)
177 call this%Xh_GL%init(gl, lxd, lxd, lxd)
182 call this%dm_Xh%init(msh, this%Xh)
183 call this%dm_Xh_GL%init(msh, this%Xh_GL)
185 call this%gs_Xh%init(this%dm_Xh)
186 call this%gs_Xh_GL%init(this%dm_Xh_GL)
188 call this%c_Xh%init(this%gs_Xh)
189 call this%c_Xh_GL%init(this%gs_Xh_GL)
191 call this%GLL_to_GL%init(this%Xh_GL, this%Xh)
194 call this%scratch_GL%init(5, 2, this%dm_Xh_GL)
197 call json_get_or_default(params,
'case.fluid.name', this%name,
"fluid")
203 call neko_log%section(
'Adjoint fluid')
204 write(log_buf,
'(A, A)')
'Type : ', trim(scheme)
205 call neko_log%message(log_buf)
206 write(log_buf,
'(A, A)')
'Name : ', trim(this%name)
207 call neko_log%message(log_buf)
210 call neko_registry%add_field(this%dm_Xh,
'u_adj')
211 call neko_registry%add_field(this%dm_Xh,
'v_adj')
212 call neko_registry%add_field(this%dm_Xh,
'w_adj')
213 this%u_adj => neko_registry%get_field(
'u_adj')
214 this%v_adj => neko_registry%get_field(
'v_adj')
215 this%w_adj => neko_registry%get_field(
'w_adj')
220 call this%set_material_properties(params, user)
224 'case.adjoint_fluid.velocity_solver.projection_space_size', &
225 'case.fluid.velocity_solver.projection_space_size')
226 call json_get_or_default(params, json_key, this%vel_projection_dim, 0)
228 'case.adjoint_fluid.pressure_solver.projection_space_size', &
229 'case.fluid.pressure_solver.projection_space_size')
230 call json_get_or_default(params, json_key, this%pr_projection_dim, 0)
233 'case.adjoint_fluid.velocity_solver.projection_hold_steps', &
234 'case.fluid.velocity_solver.projection_hold_steps')
235 call json_get_or_default(params, json_key, &
236 this%vel_projection_activ_step, 5)
238 'case.adjoint_fluid.pressure_solver.projection_hold_steps', &
239 'case.fluid.pressure_solver.projection_hold_steps')
240 call json_get_or_default(params, json_key, &
241 this%pr_projection_activ_step, 5)
245 call json_get_or_default(params, json_key, this%freeze, .false.)
254 if (params%valid_path(
"case.fluid.flow_rate_force"))
then
255 call neko_error(
'Flow rate forcing not yet implemented')
256 this%forced_flow_rate = .true.
261 write(log_buf,
'(A, I1)')
'Poly order : ', lx-1
262 else if (lx .ge. 10)
then
263 write(log_buf,
'(A, I2)')
'Poly order : ', lx-1
265 write(log_buf,
'(A, I3)')
'Poly order : ', lx-1
267 call neko_log%message(log_buf)
268 this%glb_n_points = int(this%msh%glb_nelv, i8)*int(this%Xh%lxyz, i8)
269 this%glb_unique_points = int(glsum(this%c_Xh%mult, this%dm_Xh%size()), i8)
271 write(log_buf,
'(A, I0)')
'GLL points : ', this%glb_n_points
272 call neko_log%message(log_buf)
273 write(log_buf,
'(A, I0)')
'Unique pts.: ', this%glb_unique_points
274 call neko_log%message(log_buf)
276 call json_get(params,
'case.numerics.dealias', logical_val)
277 write(log_buf,
'(A, L1)')
'Dealias : ', logical_val
278 call neko_log%message(log_buf)
280 call json_get_or_default(params,
'case.output_boundary', logical_val, &
282 write(log_buf,
'(A, L1)')
'Save bdry : ', logical_val
283 call neko_log%message(log_buf)
285 call json_get_or_default(params,
"case.fluid.full_stress_formulation", &
286 logical_val, .false.)
287 write(log_buf,
'(A, L1)')
'Full stress: ', logical_val
288 call neko_log%message(log_buf)
293 allocate(this%f_adj_x)
294 allocate(this%f_adj_y)
295 allocate(this%f_adj_z)
296 call this%f_adj_x%init(this%dm_Xh, fld_name =
"adjoint_rhs_x")
297 call this%f_adj_y%init(this%dm_Xh, fld_name =
"adjoint_rhs_y")
298 call this%f_adj_z%init(this%dm_Xh, fld_name =
"adjoint_rhs_z")
318 call neko_log%section(
"Adjoint Velocity solver")
321 'case.adjoint_fluid.velocity_solver.max_iterations', &
322 'case.fluid.velocity_solver.max_iterations')
323 call json_get_or_default(params, json_key, integer_val, ksp_max_iter)
326 'case.adjoint_fluid.velocity_solver.type', &
327 'case.fluid.velocity_solver.type')
328 call json_get(params, json_key, string_val1)
331 'case.adjoint_fluid.velocity_solver.preconditioner.type', &
332 'case.fluid.velocity_solver.preconditioner.type')
333 call json_get(params, json_key, string_val2)
336 'case.adjoint_fluid.velocity_solver.preconditioner', &
337 'case.fluid.velocity_solver.preconditioner')
338 call json_get(params, json_key, json_subdict)
341 'case.adjoint_fluid.velocity_solver.absolute_tolerance', &
342 'case.fluid.velocity_solver.absolute_tolerance')
343 call json_get(params, json_key, real_val)
346 'case.adjoint_fluid.velocity_solver.monitor', &
347 'case.fluid.velocity_solver.monitor')
348 call json_get_or_default(params, json_key, logical_val, .false.)
350 call neko_log%message(
'Type : (' // trim(string_val1) // &
351 ', ' // trim(string_val2) //
')')
353 write(log_buf,
'(A,ES13.6)')
'Abs tol :', real_val
354 call neko_log%message(log_buf)
355 call this%solver_factory(this%ksp_vel, this%dm_Xh%size(), &
356 string_val1, integer_val, real_val, logical_val)
357 call this%precon_factory_(this%pc_vel, this%ksp_vel, &
358 this%c_Xh, this%dm_Xh, this%gs_Xh, this%bcs_vel, &
359 string_val2, json_subdict)
360 call neko_log%end_section()
364 call json_get_or_default(params,
'case.fluid.strict_convergence', &
365 this%strict_convergence, .false.)
368 call this%ulag%init(this%u_adj, 2)
369 call this%vlag%init(this%v_adj, 2)
370 call this%wlag%init(this%w_adj, 2)
372 call neko_registry%add_field(this%dm_Xh,
'u_adj_e')
373 call neko_registry%add_field(this%dm_Xh,
'v_adj_e')
374 call neko_registry%add_field(this%dm_Xh,
'w_adj_e')
375 this%u_adj_e => neko_registry%get_field(
'u_adj_e')
376 this%v_adj_e => neko_registry%get_field(
'v_adj_e')
377 this%w_adj_e => neko_registry%get_field(
'w_adj_e')
380 call this%source_term%init(this%f_adj_x, this%f_adj_y, this%f_adj_z, &
381 this%c_Xh, user, this%name)
382 call this%source_term%add(params,
'case.adjoint_fluid.source_term')
384 call neko_log%end_section()
386 end subroutine adjoint_fluid_scheme_init_base
389 subroutine adjoint_fluid_scheme_free(this)
390 class(adjoint_fluid_scheme_incompressible_t),
intent(inout) :: this
394 if (
allocated(this%ksp_vel))
then
395 call this%ksp_vel%free()
396 deallocate(this%ksp_vel)
399 if (
allocated(this%ksp_prs))
then
400 call this%ksp_prs%free()
401 deallocate(this%ksp_prs)
404 if (
allocated(this%pc_vel))
then
405 call precon_destroy(this%pc_vel)
406 deallocate(this%pc_vel)
409 if (
allocated(this%pc_prs))
then
410 call precon_destroy(this%pc_prs)
411 deallocate(this%pc_prs)
414 call this%source_term%free()
416 call this%gs_Xh%free()
418 call this%c_Xh%free()
420 call this%scratch_GL%free()
427 nullify(this%u_adj_e)
428 nullify(this%v_adj_e)
429 nullify(this%w_adj_e)
431 call this%ulag%free()
432 call this%vlag%free()
433 call this%wlag%free()
436 if (
associated(this%f_adj_x))
then
437 call this%f_adj_x%free()
440 if (
associated(this%f_adj_y))
then
441 call this%f_adj_y%free()
444 if (
associated(this%f_adj_z))
then
445 call this%f_adj_z%free()
448 nullify(this%f_adj_x)
449 nullify(this%f_adj_y)
450 nullify(this%f_adj_z)
455 end subroutine adjoint_fluid_scheme_free
459 subroutine adjoint_fluid_scheme_validate(this)
460 class(adjoint_fluid_scheme_incompressible_t),
target,
intent(inout) :: this
463 if ((.not.
associated(this%u_adj)) .or. &
464 (.not.
associated(this%v_adj)) .or. &
465 (.not.
associated(this%w_adj)) .or. &
466 (.not.
associated(this%p_adj)))
then
467 call neko_error(
'Fields are not registered')
470 if ((.not.
allocated(this%u_adj%x)) .or. &
471 (.not.
allocated(this%v_adj%x)) .or. &
472 (.not.
allocated(this%w_adj%x)) .or. &
473 (.not.
allocated(this%p_adj%x)))
then
474 call neko_error(
'Fields are not allocated')
477 if (.not.
allocated(this%ksp_vel))
then
478 call neko_error(
'No Krylov solver for velocity defined')
481 if (.not.
allocated(this%ksp_prs))
then
482 call neko_error(
'No Krylov solver for pressure defined')
488 call this%chkp%init(this%u_adj, this%v_adj, this%w_adj, this%p_adj)
490 end subroutine adjoint_fluid_scheme_validate
496 subroutine adjoint_fluid_scheme_bc_apply_vel(this, time, strong)
497 class(adjoint_fluid_scheme_incompressible_t),
intent(inout) :: this
498 type(time_state_t),
intent(in) :: time
499 logical,
intent(in) :: strong
502 class(bc_t),
pointer :: b => null()
504 call this%bcs_vel%apply_vector(&
505 this%u_adj%x, this%v_adj%x, this%w_adj%x, this%dm_Xh%size(), &
507 call this%gs_Xh%op(this%u_adj, gs_op_min, glb_cmd_event)
508 call this%gs_Xh%op(this%v_adj, gs_op_min, glb_cmd_event)
509 call this%gs_Xh%op(this%w_adj, gs_op_min, glb_cmd_event)
510 call device_event_sync(glb_cmd_event)
512 call this%bcs_vel%apply_vector(&
513 this%u_adj%x, this%v_adj%x, this%w_adj%x, this%dm_Xh%size(), &
515 call this%gs_Xh%op(this%u_adj, gs_op_max, glb_cmd_event)
516 call this%gs_Xh%op(this%v_adj, gs_op_max, glb_cmd_event)
517 call this%gs_Xh%op(this%w_adj, gs_op_max, glb_cmd_event)
518 call device_event_sync(glb_cmd_event)
520 do i = 1, this%bcs_vel%size()
521 b => this%bcs_vel%get(i)
527 end subroutine adjoint_fluid_scheme_bc_apply_vel
531 subroutine adjoint_fluid_scheme_bc_apply_prs(this, time)
532 class(adjoint_fluid_scheme_incompressible_t),
intent(inout) :: this
533 type(time_state_t),
intent(in) :: time
536 class(bc_t),
pointer :: b => null()
538 call this%bcs_prs%apply(this%p_adj, time)
539 call this%gs_Xh%op(this%p_adj, gs_op_min, glb_cmd_event)
540 call device_event_sync(glb_cmd_event)
542 call this%bcs_prs%apply(this%p_adj, time)
543 call this%gs_Xh%op(this%p_adj, gs_op_max, glb_cmd_event)
544 call device_event_sync(glb_cmd_event)
546 do i = 1, this%bcs_prs%size()
547 b => this%bcs_prs%get(i)
552 end subroutine adjoint_fluid_scheme_bc_apply_prs
556 subroutine adjoint_fluid_scheme_solver_factory(ksp, n, solver, &
557 max_iter, abstol, monitor)
558 class(ksp_t),
allocatable,
target,
intent(inout) :: ksp
559 integer,
intent(in),
value :: n
560 character(len=*),
intent(in) :: solver
561 integer,
intent(in) :: max_iter
562 real(kind=rp),
intent(in) :: abstol
563 logical,
intent(in) :: monitor
565 call krylov_solver_factory(ksp, n, solver, max_iter, abstol, &
568 end subroutine adjoint_fluid_scheme_solver_factory
571 subroutine adjoint_fluid_scheme_precon_factory(this, pc, ksp, coef, dof, gs, &
572 bclst, pctype, pcparams)
573 class(adjoint_fluid_scheme_incompressible_t),
intent(inout) :: this
574 class(pc_t),
allocatable,
target,
intent(inout) :: pc
575 class(ksp_t),
target,
intent(inout) :: ksp
576 type(coef_t),
target,
intent(in) :: coef
577 type(dofmap_t),
target,
intent(in) :: dof
578 type(gs_t),
target,
intent(inout) :: gs
579 type(bc_list_t),
target,
intent(inout) :: bclst
580 character(len=*) :: pctype
581 type(json_file),
intent(inout) :: pcparams
583 call precon_factory(pc, pctype)
585 select type (pcp => pc)
587 call pcp%init(coef, dof, gs)
588 type is (sx_jacobi_t)
589 call pcp%init(coef, dof, gs)
590 type is (device_jacobi_t)
591 call pcp%init(coef, dof, gs)
593 call pcp%init(coef, bclst, pcparams)
595 call pcp%init(coef, bclst, pcparams)
600 end subroutine adjoint_fluid_scheme_precon_factory
619 function adjoint_compute_cfl(this, dt)
result(c)
620 class(adjoint_fluid_scheme_incompressible_t),
intent(in) :: this
621 real(kind=rp),
intent(in) :: dt
624 c = cfl(dt, this%u_adj%x, this%v_adj%x, this%w_adj%x, &
625 this%Xh, this%c_Xh, this%msh%nelv, this%msh%gdim)
627 end function adjoint_compute_cfl
633 subroutine adjoint_fluid_scheme_update_material_properties(this, time)
634 class(adjoint_fluid_scheme_incompressible_t),
intent(inout) :: this
635 type(time_state_t),
intent(in) :: time
636 type(field_t),
pointer :: nut
638 call this%user_material_properties(this%name, &
639 this%material_properties, time)
641 if (len(trim(this%nut_field_name)) > 0)
then
642 nut => neko_registry%get_field(this%nut_field_name)
643 call field_addcol3(this%mu, nut, this%rho)
650 if (neko_bcknd_device .eq. 1)
then
651 call device_memcpy(this%rho%x, this%rho%x_d, this%rho%size(), &
652 device_to_host, sync=.false.)
653 call device_memcpy(this%mu%x, this%mu%x_d, this%mu%size(), &
654 device_to_host, sync=.false.)
656 end subroutine adjoint_fluid_scheme_update_material_properties
662 subroutine adjoint_fluid_scheme_set_material_properties(this, params, user)
663 class(adjoint_fluid_scheme_incompressible_t),
intent(inout) :: this
664 type(json_file),
intent(inout) :: params
665 type(user_t),
target,
intent(in) :: user
666 character(len=LOG_SIZE) :: log_buf
668 procedure(user_material_properties_intf),
pointer :: dummy_mp_ptr
669 real(kind=rp) :: const_mu, const_rho
670 type(time_state_t) :: time
673 dummy_mp_ptr => dummy_user_material_properties
675 call this%mu%init(this%dm_Xh,
"mu")
676 call this%rho%init(this%dm_Xh,
"rho")
677 call this%material_properties%init(2)
678 call this%material_properties%assign_to_field(1, this%rho)
679 call this%material_properties%assign_to_field(2, this%mu)
681 if (.not.
associated(user%material_properties, dummy_mp_ptr))
then
683 write(log_buf,
'(A)')
"Material properties must be set in the user&
685 call neko_log%message(log_buf)
686 this%user_material_properties => user%material_properties
688 call user%material_properties(this%name, &
689 this%material_properties, time)
692 this%user_material_properties => dummy_user_material_properties
694 if (params%valid_path(
'case.fluid.Re') .and. &
695 (params%valid_path(
'case.fluid.mu') .or. &
696 params%valid_path(
'case.fluid.rho')))
then
697 call neko_error(
"To set the material properties for the fluid, " // &
698 "either provide Re OR mu and rho in the case file.")
700 else if (params%valid_path(
'case.fluid.Re'))
then
702 write(log_buf,
'(A)')
'Non-dimensional fluid material properties &
704 call neko_log%message(log_buf, lvl = neko_log_verbose)
705 write(log_buf,
'(A)')
'Density will be set to 1, dynamic viscosity to&
707 call neko_log%message(log_buf, lvl = neko_log_verbose)
710 call json_get(params,
'case.fluid.Re', const_mu)
711 write(log_buf,
'(A)')
'Read non-dimensional material properties'
712 call neko_log%message(log_buf)
713 write(log_buf,
'(A,ES13.6)')
'Re :', const_mu
714 call neko_log%message(log_buf)
719 const_mu = 1.0_rp/const_mu
722 call json_get(params,
'case.fluid.mu', const_mu)
723 call json_get(params,
'case.fluid.rho', const_rho)
729 if (
associated(user%material_properties, dummy_mp_ptr))
then
731 call field_cfill(this%mu, const_mu)
732 call field_cfill(this%rho, const_rho)
735 write(log_buf,
'(A,ES13.6)')
'rho :', const_rho
736 call neko_log%message(log_buf)
737 write(log_buf,
'(A,ES13.6)')
'mu :', const_mu
738 call neko_log%message(log_buf)
745 if (neko_bcknd_device .eq. 1)
then
746 call device_memcpy(this%rho%x, this%rho%x_d, this%rho%size(), &
747 device_to_host, sync=.false.)
748 call device_memcpy(this%mu%x, this%mu%x_d, this%mu%size(), &
749 device_to_host, sync=.false.)
751 end subroutine adjoint_fluid_scheme_set_material_properties
subroutine adjoint_fluid_scheme_init_base(this, msh, lx, params, scheme, user, kspv_init)
Initialise an adjoint scheme.
Implements the adjoint_source_term_t type.
Base type of all fluid formulations.
Base type of all fluid formulations.
Wrapper contaning and executing the adjoint source terms.