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()
489 call this%chkp%add_fluid(this%u_adj, this%v_adj, this%w_adj, this%p_adj)
491 end subroutine adjoint_fluid_scheme_validate
497 subroutine adjoint_fluid_scheme_bc_apply_vel(this, time, strong)
498 class(adjoint_fluid_scheme_incompressible_t),
intent(inout) :: this
499 type(time_state_t),
intent(in) :: time
500 logical,
intent(in) :: strong
503 class(bc_t),
pointer :: b => null()
505 call this%bcs_vel%apply_vector(&
506 this%u_adj%x, this%v_adj%x, this%w_adj%x, this%dm_Xh%size(), &
508 call this%gs_Xh%op(this%u_adj, gs_op_min, glb_cmd_event)
509 call this%gs_Xh%op(this%v_adj, gs_op_min, glb_cmd_event)
510 call this%gs_Xh%op(this%w_adj, gs_op_min, glb_cmd_event)
511 call device_event_sync(glb_cmd_event)
513 call this%bcs_vel%apply_vector(&
514 this%u_adj%x, this%v_adj%x, this%w_adj%x, this%dm_Xh%size(), &
516 call this%gs_Xh%op(this%u_adj, gs_op_max, glb_cmd_event)
517 call this%gs_Xh%op(this%v_adj, gs_op_max, glb_cmd_event)
518 call this%gs_Xh%op(this%w_adj, gs_op_max, glb_cmd_event)
519 call device_event_sync(glb_cmd_event)
521 do i = 1, this%bcs_vel%size()
522 b => this%bcs_vel%get(i)
528 end subroutine adjoint_fluid_scheme_bc_apply_vel
532 subroutine adjoint_fluid_scheme_bc_apply_prs(this, time)
533 class(adjoint_fluid_scheme_incompressible_t),
intent(inout) :: this
534 type(time_state_t),
intent(in) :: time
537 class(bc_t),
pointer :: b => null()
539 call this%bcs_prs%apply(this%p_adj, time)
540 call this%gs_Xh%op(this%p_adj, gs_op_min, glb_cmd_event)
541 call device_event_sync(glb_cmd_event)
543 call this%bcs_prs%apply(this%p_adj, time)
544 call this%gs_Xh%op(this%p_adj, gs_op_max, glb_cmd_event)
545 call device_event_sync(glb_cmd_event)
547 do i = 1, this%bcs_prs%size()
548 b => this%bcs_prs%get(i)
553 end subroutine adjoint_fluid_scheme_bc_apply_prs
557 subroutine adjoint_fluid_scheme_solver_factory(ksp, n, solver, &
558 max_iter, abstol, monitor)
559 class(ksp_t),
allocatable,
target,
intent(inout) :: ksp
560 integer,
intent(in),
value :: n
561 character(len=*),
intent(in) :: solver
562 integer,
intent(in) :: max_iter
563 real(kind=rp),
intent(in) :: abstol
564 logical,
intent(in) :: monitor
566 call krylov_solver_factory(ksp, n, solver, max_iter, abstol, &
569 end subroutine adjoint_fluid_scheme_solver_factory
572 subroutine adjoint_fluid_scheme_precon_factory(this, pc, ksp, coef, dof, gs, &
573 bclst, pctype, pcparams)
574 class(adjoint_fluid_scheme_incompressible_t),
intent(inout) :: this
575 class(pc_t),
allocatable,
target,
intent(inout) :: pc
576 class(ksp_t),
target,
intent(inout) :: ksp
577 type(coef_t),
target,
intent(in) :: coef
578 type(dofmap_t),
target,
intent(in) :: dof
579 type(gs_t),
target,
intent(inout) :: gs
580 type(bc_list_t),
target,
intent(inout) :: bclst
581 character(len=*) :: pctype
582 type(json_file),
intent(inout) :: pcparams
584 call precon_factory(pc, pctype)
586 select type (pcp => pc)
588 call pcp%init(coef, dof, gs)
589 type is (sx_jacobi_t)
590 call pcp%init(coef, dof, gs)
591 type is (device_jacobi_t)
592 call pcp%init(coef, dof, gs)
594 call pcp%init(coef, bclst, pcparams)
596 call pcp%init(coef, bclst, pcparams)
601 end subroutine adjoint_fluid_scheme_precon_factory
620 function adjoint_compute_cfl(this, dt)
result(c)
621 class(adjoint_fluid_scheme_incompressible_t),
intent(in) :: this
622 real(kind=rp),
intent(in) :: dt
625 c = cfl(dt, this%u_adj%x, this%v_adj%x, this%w_adj%x, &
626 this%Xh, this%c_Xh, this%msh%nelv, this%msh%gdim)
628 end function adjoint_compute_cfl
634 subroutine adjoint_fluid_scheme_update_material_properties(this, time)
635 class(adjoint_fluid_scheme_incompressible_t),
intent(inout) :: this
636 type(time_state_t),
intent(in) :: time
637 type(field_t),
pointer :: nut
639 call this%user_material_properties(this%name, &
640 this%material_properties, time)
642 if (len(trim(this%nut_field_name)) > 0)
then
643 nut => neko_registry%get_field(this%nut_field_name)
644 call field_addcol3(this%mu, nut, this%rho)
651 if (neko_bcknd_device .eq. 1)
then
652 call device_memcpy(this%rho%x, this%rho%x_d, this%rho%size(), &
653 device_to_host, sync=.false.)
654 call device_memcpy(this%mu%x, this%mu%x_d, this%mu%size(), &
655 device_to_host, sync=.false.)
657 end subroutine adjoint_fluid_scheme_update_material_properties
663 subroutine adjoint_fluid_scheme_set_material_properties(this, params, user)
664 class(adjoint_fluid_scheme_incompressible_t),
intent(inout) :: this
665 type(json_file),
intent(inout) :: params
666 type(user_t),
target,
intent(in) :: user
667 character(len=LOG_SIZE) :: log_buf
669 procedure(user_material_properties_intf),
pointer :: dummy_mp_ptr
670 real(kind=rp) :: const_mu, const_rho
671 type(time_state_t) :: time
674 dummy_mp_ptr => dummy_user_material_properties
676 call this%mu%init(this%dm_Xh,
"mu")
677 call this%rho%init(this%dm_Xh,
"rho")
678 call this%material_properties%init(2)
679 call this%material_properties%assign_to_field(1, this%rho)
680 call this%material_properties%assign_to_field(2, this%mu)
682 if (.not.
associated(user%material_properties, dummy_mp_ptr))
then
684 write(log_buf,
'(A)')
"Material properties must be set in the user&
686 call neko_log%message(log_buf)
687 this%user_material_properties => user%material_properties
689 call user%material_properties(this%name, &
690 this%material_properties, time)
693 this%user_material_properties => dummy_user_material_properties
695 if (params%valid_path(
'case.fluid.Re') .and. &
696 (params%valid_path(
'case.fluid.mu') .or. &
697 params%valid_path(
'case.fluid.rho')))
then
698 call neko_error(
"To set the material properties for the fluid, " // &
699 "either provide Re OR mu and rho in the case file.")
701 else if (params%valid_path(
'case.fluid.Re'))
then
703 write(log_buf,
'(A)')
'Non-dimensional fluid material properties &
705 call neko_log%message(log_buf, lvl = neko_log_verbose)
706 write(log_buf,
'(A)')
'Density will be set to 1, dynamic viscosity to&
708 call neko_log%message(log_buf, lvl = neko_log_verbose)
711 call json_get(params,
'case.fluid.Re', const_mu)
712 write(log_buf,
'(A)')
'Read non-dimensional material properties'
713 call neko_log%message(log_buf)
714 write(log_buf,
'(A,ES13.6)')
'Re :', const_mu
715 call neko_log%message(log_buf)
720 const_mu = 1.0_rp/const_mu
723 call json_get(params,
'case.fluid.mu', const_mu)
724 call json_get(params,
'case.fluid.rho', const_rho)
730 if (
associated(user%material_properties, dummy_mp_ptr))
then
732 call field_cfill(this%mu, const_mu)
733 call field_cfill(this%rho, const_rho)
736 write(log_buf,
'(A,ES13.6)')
'rho :', const_rho
737 call neko_log%message(log_buf)
738 write(log_buf,
'(A,ES13.6)')
'mu :', const_mu
739 call neko_log%message(log_buf)
746 if (neko_bcknd_device .eq. 1)
then
747 call device_memcpy(this%rho%x, this%rho%x_d, this%rho%size(), &
748 device_to_host, sync=.false.)
749 call device_memcpy(this%mu%x, this%mu%x_d, this%mu%size(), &
750 device_to_host, sync=.false.)
752 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.