objective.f90

Go to the documentation of this file.

 
 
module objective
  use base_functional, only: base_functional_t
  use simulation_m, only: simulation_t
  use design, only: design_t
  use num_types, only: rp
  use point_zone_registry, only: neko_point_zone_registry
  use json_module, only: json_file
  implicit none
  private
 
  public :: objective_t, objective_factory, objective_wrapper_t
 
  type, abstract, extends(base_functional_t) :: objective_t
     real(kind=rp) :: weight = 1.0_rp
 
   contains
 
     procedure, pass(this) :: init_base => objective_init_base
     procedure, pass(this) :: free_base => objective_free_base
     procedure, pass(this) :: get_weight => objective_get_weight
     procedure, pass(this) :: get_log_size => objective_get_log_size
     procedure, pass(this) :: get_log_headers => objective_get_log_headers
     procedure, pass(this) :: get_log_values => objective_get_log_values
 
  end type objective_t
 
  type :: objective_wrapper_t
     class(objective_t), allocatable :: objective
   contains
     procedure, pass(this) :: free => objective_wrapper_free
  end type objective_wrapper_t
 
  ! -------------------------------------------------------------------------- !
  ! Explicit interfaces
 
  interface objective_factory
     module subroutine objective_factory(object, json, design, simulation)
       class(objective_t), allocatable, intent(inout) :: object
       type(json_file), intent(inout) :: json
       class(design_t), intent(in) :: design
       type(simulation_t), target, optional, intent(inout) :: simulation
     end subroutine objective_factory
  end interface objective_factory
 
contains
 
  ! -------------------------------------------------------------------------- !
  ! Implementations for the base class
 
  subroutine objective_init_base(this, name, design_size, weight, mask_name, &
       start_time, end_time)
    class(objective_t), intent(inout) :: this
    character(len=*), intent(in) :: name
    integer, intent(in) :: design_size
    real(kind=rp), intent(in) :: weight
    character(len=*), intent(in), optional :: mask_name
    real(kind=rp), intent(in), optional :: start_time
    real(kind=rp), intent(in), optional :: end_time
 
    call this%free_base()
 
    this%name = name
    call this%sensitivity%init(design_size)
    call this%sensitivity_old%init(design_size)
 
    this%weight = weight
 
    if (present(mask_name)) then
       if (mask_name .ne. "") then
          this%has_mask = .true.
          this%mask => neko_point_zone_registry%get_point_zone(mask_name)
       end if
    end if
 
    if (present(start_time)) then
       this%start_time = start_time
    else
       this%start_time = 0.0_rp
    end if
 
    if (present(end_time)) then
       this%end_time = end_time
    else
       this%end_time = huge(0.0_rp)
    end if
 
  end subroutine objective_init_base
 
  subroutine objective_free_base(this)
    class(objective_t), target, intent(inout) :: this
 
    this%name = ""
    this%weight = 1.0_rp
 
    this%value = 0.0_rp
    this%value_old = 0.0_rp
    this%start_time = 0.0_rp
    this%end_time = huge(0.0_rp)
    call this%sensitivity%free()
    call this%sensitivity_old%free()
 
    this%has_mask = .false.
    if (associated(this%mask)) nullify(this%mask)
 
  end subroutine objective_free_base
 
  function objective_get_log_size(this) result(n)
    class(objective_t), intent(in) :: this
    integer :: n
 
    n = 2
  end function objective_get_log_size
 
  subroutine objective_get_log_headers(this, headers)
    class(objective_t), intent(in) :: this
    character(len=*), intent(out) :: headers(:)
    character(len=64) :: prefix
 
    if (size(headers) .lt. 1) return
    prefix = trim(this%name)
    headers(1) = prefix
    if (size(headers) .lt. 2) return
    headers(2) = trim(prefix) // '.weight'
  end subroutine objective_get_log_headers
 
  subroutine objective_get_log_values(this, values)
    class(objective_t), intent(in) :: this
    real(kind=rp), intent(out) :: values(:)
 
    if (size(values) .lt. 1) return
    values(1) = this%value
    if (size(values) .lt. 2) return
    values(2) = this%weight
  end subroutine objective_get_log_values
 
  ! -------------------------------------------------------------------------- !
  ! Implementations for the wrapper
 
  subroutine objective_wrapper_free(this)
    class(objective_wrapper_t), intent(inout) :: this
    if (allocated(this%objective)) then
       call this%objective%free()
       deallocate(this%objective)
    end if
  end subroutine objective_wrapper_free
 
  pure function objective_get_weight(this) result(w)
    class(objective_t), intent(in) :: this
    real(kind=rp) :: w
    w = this%weight
  end function objective_get_weight
 
end module objective