brinkman_dissipation_objective.f90

Go to the documentation of this file.

 
!
!
! F = \int |\nabla u|^2  + K \int \chi \u^2
!
!  |viscous dissipation | |"Brinkman dissipation"|
!
module brinkman_dissipation_objective
  use objective, only: objective_t
  use design, only: design_t
  use brinkman_design, only: brinkman_design_t
  use simulation_m, only: simulation_t
  use adjoint_brinkman_dissipation_source_term, only: &
       adjoint_brinkman_dissipation_source_term_t
  use adjoint_fluid_pnpn, only: adjoint_fluid_pnpn_t
  use num_types, only: rp
  use field, only: field_t
  use scratch_registry, only: neko_scratch_registry, scratch_registry_t
  use neko_config, only: neko_bcknd_device
  use mask_ops, only: mask_exterior_const, compute_masked_volume
  use utils, only: neko_error
  use json_module, only: json_file
  use json_utils, only: json_get_or_default
  use registry, only: neko_registry
  use interpolation, only: interpolator_t
  use space, only: space_t, gl
  use coefs, only: coef_t
  use math, only: glsc2, copy, col2, invcol2
  use device_math, only: device_copy, device_glsc2, device_col2, device_invcol2
  use math_ext, only: glsc2_mask
  use field_math, only: field_col3, field_addcol3, field_cmult, field_col2
  use continuation_scheduler, only: nekotop_continuation
  implicit none
  private
 
  type, public, extends(objective_t) :: brinkman_dissipation_objective_t
     private
 
     type(field_t), pointer :: u => null()
     type(field_t), pointer :: v => null()
     type(field_t), pointer :: w => null()
     type(field_t), pointer :: brinkman_amplitude => null()
     logical :: dealias_sensitivity
     logical :: dealias_forcing
     real(kind=rp) :: volume
 
     ! ---- everything GLL ----
     type(coef_t), pointer :: c_xh_gll
     type(space_t), pointer :: xh_gll
 
     ! ---- everything for GL ----
     type(space_t), pointer :: xh_gl
     type(coef_t), pointer :: c_xh_gl
     type(interpolator_t), pointer :: gll_to_gl
     type(scratch_registry_t), pointer :: scratch_gl
     integer :: gdim
 
 
   contains
 
     procedure, public, pass(this) :: init_json_sim => &
          brinkman_dissipation_init_json_sim
     procedure, public, pass(this) :: init_from_attributes => &
          brinkman_dissipation_init_attributes
     procedure, public, pass(this) :: free => brinkman_dissipation_free
     procedure, public, pass(this) :: update_value => &
          brinkman_dissipation_update_value
     procedure, public, pass(this) :: update_sensitivity => &
          brinkman_dissipation_update_sensitivity
 
  end type brinkman_dissipation_objective_t
 
contains
 
  subroutine brinkman_dissipation_init_json_sim(this, json, design, simulation)
    class(brinkman_dissipation_objective_t), intent(inout) :: this
    type(json_file), intent(inout) :: json
    class(design_t), intent(in) :: design
    type(simulation_t), target, intent(inout) :: simulation
 
    character(len=:), allocatable :: mask_name
    character(len=:), allocatable :: name
    real(kind=rp) :: weight
    logical :: dealias_sensitivity, dealias_forcing
    real(kind=rp) :: start_time, end_time
 
    call nekotop_continuation%json_get_or_register(json, 'weight', &
         this%weight, weight, 1.0_rp)
    call json_get_or_default(json, "mask_name", mask_name, "")
    call json_get_or_default(json, "name", name, "Out of plane stresses")
    call json_get_or_default(json, "dealias_sensitivity", &
         dealias_sensitivity, .true.)
    call json_get_or_default(json, "dealias_forcing", &
         dealias_forcing, .true.)
    call json_get_or_default(json, "start_time", start_time, 0.0_rp)
    call json_get_or_default(json, "end_time", end_time, huge(0.0_rp))
 
    call this%init_from_attributes(design, simulation, weight, name, &
         mask_name, dealias_sensitivity, dealias_forcing, start_time, &
         end_time)
  end subroutine brinkman_dissipation_init_json_sim
 
  subroutine brinkman_dissipation_init_attributes(this, design, simulation, &
       weight, name, mask_name, dealias_sensitivity, dealias_forcing, &
       start_time, end_time)
    class(brinkman_dissipation_objective_t), intent(inout) :: this
    class(design_t), intent(in) :: design
    type(simulation_t), target, intent(inout) :: simulation
    real(kind=rp), intent(in) :: weight
    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: mask_name
    logical, intent(in) :: dealias_sensitivity
    logical, intent(in) :: dealias_forcing
    real(kind=rp), intent(in) :: start_time
    real(kind=rp), intent(in) :: end_time
 
    type(adjoint_brinkman_dissipation_source_term_t) :: brinkman_dissipation
 
    ! Call the base initializer
    call this%init_base(name, design%size(), weight, mask_name, &
         start_time, end_time)
 
    this%dealias_forcing = dealias_forcing
    this%dealias_sensitivity = dealias_sensitivity
 
    ! Grab the Brinkman amplitude field.
    select type (design)
    type is (brinkman_design_t)
       this%brinkman_amplitude => &
            neko_registry%get_field("brinkman_amplitude")
 
 
    class default
       call neko_error('Brinkman dissipation only works with '// &
            'brinkman_design')
    end select
 
    this%u => neko_registry%get_field('u')
    this%v => neko_registry%get_field('v')
    this%w => neko_registry%get_field('w')
 
    ! GLL
    this%c_Xh_GLL => simulation%neko_case%fluid%c_Xh
    this%Xh_GLL => simulation%neko_case%fluid%c_Xh%Xh
    this%gdim = this%c_Xh_GLL%msh%gdim
 
    ! GL
    this%c_Xh_GL => simulation%adjoint_case%fluid_adj%c_Xh_GL
    this%Xh_GL => this%c_Xh_GL%Xh
 
    ! GLL to GL
    this%GLL_to_GL => simulation%adjoint_case%fluid_adj%GLL_to_GL
 
    this%scratch_GL => simulation%adjoint_case%fluid_adj%scratch_GL
 
    ! compute the volume of the objective domain
    if (this%has_mask) then
       this%volume = compute_masked_volume(this%mask, this%c_Xh_GLL)
    else
       this%volume = this%c_Xh_GLL%volume
    end if
 
    ! if we have the Brinkman dissipation we initialize and append it too
 
    associate(f_adj_x => simulation%adjoint_fluid%f_adj_x, &
         f_adj_y => simulation%adjoint_fluid%f_adj_y, &
         f_adj_z => simulation%adjoint_fluid%f_adj_z)
 
      call brinkman_dissipation%init_from_components(f_adj_x, f_adj_y, &
           f_adj_z, design, this%weight, this%u, this%v, this%w, this%mask, &
           this%has_mask, this%c_Xh_GLL, this%c_Xh_GL, this%GLL_to_GL, &
           this%dealias_forcing, this%volume, this%scratch_GL, this%gdim, &
           this%start_time, this%end_time)
 
    end associate
 
    ! append adjoint forcing term based on objective function
    select type (f => simulation%adjoint_fluid)
    type is (adjoint_fluid_pnpn_t)
       call f%source_term%add_source_term(brinkman_dissipation)
    end select
 
  end subroutine brinkman_dissipation_init_attributes
 
  subroutine brinkman_dissipation_free(this)
    class(brinkman_dissipation_objective_t), intent(inout) :: this
    call this%free_base()
 
    this%u => null()
    this%v => null()
    this%w => null()
    this%c_Xh_GLL => null()
    this%brinkman_amplitude => null()
    nullify(this%c_Xh_GL)
    nullify(this%Xh_GL)
    nullify(this%Xh_GLL)
    nullify(this%GLL_to_GL)
    nullify(this%scratch_GL)
 
  end subroutine brinkman_dissipation_free
 
  subroutine brinkman_dissipation_update_value(this, design)
    class(brinkman_dissipation_objective_t), intent(inout) :: this
    class(design_t), intent(in) :: design
    type(field_t), pointer :: work
    integer :: temp_indices(1)
 
    call neko_scratch_registry%request_field(work, temp_indices(1), .false.)
 
    call field_col3(work, this%u, this%u)
    call field_addcol3(work, this%v, this%v)
    if (this%gdim .eq. 3) then
       call field_addcol3(work, this%w, this%w)
    end if
    call field_col2(work, this%brinkman_amplitude)
 
    if (this%has_mask) then
       if (neko_bcknd_device .eq. 1) then
          ! note, this could be done more elagantly by writing
          ! device_glsc2_mask
          call mask_exterior_const(work, this%mask, 0.0_rp)
          this%value = device_glsc2(work%x_d, this%c_Xh_GLL%B_d, design%size())
       else
          this%value = glsc2_mask(work%x, this%c_Xh_GLL%B, design%size(), &
               this%mask%mask%get(), this%mask%size)
       end if
    else
       if (neko_bcknd_device .eq. 1) then
          this%value = device_glsc2(work%x_d, this%c_Xh_GLL%B_d, design%size())
       else
          this%value = glsc2(work%x, this%c_Xh_GLL%B, design%size())
       end if
    end if
    this%value = 0.5_rp * this%value / this%volume
 
    call neko_scratch_registry%relinquish_field(temp_indices)
 
  end subroutine brinkman_dissipation_update_value
 
  subroutine brinkman_dissipation_update_sensitivity(this, design)
    class(brinkman_dissipation_objective_t), intent(inout) :: this
    class(design_t), intent(in) :: design
    type(field_t), pointer :: work
    integer :: temp_indices(1)
    integer :: n_GL, nel
    type(field_t), pointer :: accumulate, fld_GL
    integer :: temp_indices_GL(2)
 
    ! The Brinkman dissipation adds an extra term in the sensitivity.
 
    call neko_scratch_registry%request_field(work, temp_indices(1), .false.)
 
    if(this%dealias_sensitivity) then
       nel = this%c_Xh_GLL%msh%nelv
       n_gl = nel * this%Xh_GL%lxyz
       call this%scratch_GL%request_field(accumulate, temp_indices_gl(1), &
            .false.)
       call this%scratch_GL%request_field(fld_gl, temp_indices_gl(2), .false.)
 
       call this%GLL_to_GL%map(fld_gl%x, this%u%x, nel, this%Xh_GL)
       call field_col3(accumulate, fld_gl, fld_gl)
       call this%GLL_to_GL%map(fld_gl%x, this%v%x, nel, this%Xh_GL)
       call field_addcol3(accumulate, fld_gl, fld_gl)
       if (this%gdim .eq. 3) then
          call this%GLL_to_GL%map(fld_gl%x, this%w%x, nel, this%Xh_GL)
          call field_addcol3(accumulate, fld_gl, fld_gl)
       end if
       ! scale
       call field_cmult(accumulate, this%weight * 0.5_rp / this%volume)
 
       ! Evaluate term on GL and preempt the GLL premultiplication
       if (neko_bcknd_device .eq. 1) then
          call device_col2(accumulate%x_d, this%c_Xh_GL%B_d, n_gl)
          call this%GLL_to_GL%map(work%x, accumulate%x, nel, this%Xh_GLL)
          call device_invcol2(work%x_d, this%c_Xh_GLL%B_d, work%size())
       else
          call col2(accumulate%x, this%c_Xh_GL%B, n_gl)
          call this%GLL_to_GL%map(work%x, accumulate%x, nel, this%Xh_GLL)
          call invcol2(work%x, this%c_Xh_GLL%B, work%size())
       end if
 
       call this%scratch_GL%relinquish_field(temp_indices_gl)
 
    else
       call field_col3(work, this%u, this%u)
       call field_addcol3(work, this%v, this%v)
       if (this%gdim .eq. 3) then
          call field_addcol3(work, this%w, this%w)
       end if
       ! scale
       call field_cmult(work, this%weight * 0.5_rp / this%volume)
    end if
 
    if (neko_bcknd_device .eq. 1) then
       call device_copy(this%sensitivity%x_d, work%x_d, this%sensitivity%size())
    else
       call copy(this%sensitivity%x, work%x, this%sensitivity%size())
    end if
 
    call neko_scratch_registry%relinquish_field(temp_indices)
 
  end subroutine brinkman_dissipation_update_sensitivity
 
end module brinkman_dissipation_objective