field_transfer.F90

Go to the documentation of this file.

!! Copyright (C) 2023 S. Ohlmann
!!
!! This Source Code Form is subject to the terms of the Mozilla Public
!! License, v. 2.0. If a copy of the MPL was not distributed with this
!! file, You can obtain one at https://mozilla.org/MPL/2.0/.
!!
#include "global.h"
 
 
module field_transfer_oct_m
  use debug_oct_m
  use global_oct_m
  use grid_oct_m
  use interaction_oct_m
  use interaction_partner_oct_m
  use mesh_oct_m
  use messages_oct_m
  use namespace_oct_m
  use profiling_oct_m
  use quantity_oct_m
  use regridding_oct_m
  use restart_oct_m
  use states_mxll_oct_m
  use time_interpolation_oct_m
 
  implicit none
 
  private
  public :: &
    field_transfer_t,   &
    field_transfer_init
 
  type, extends(interaction_t), abstract :: field_transfer_t
    private
    real(real64), allocatable, public     :: partner_field(:,:)
    real(real64), allocatable, public     :: system_field(:,:)
    type(grid_t), pointer, public  :: system_gr  => null() 
    type(regridding_t), pointer, public :: regridding => null()
    type(time_interpolation_t), pointer, public :: interpolation => null()
    integer, public :: ndim
    logical, public :: interpolation_initialized = .false.
 
  contains
    procedure :: init => field_transfer_init
    
    procedure :: init_from_partner => field_transfer_init_from_partner
    
    procedure :: init_interpolation => field_transfer_init_interpolation
    
    procedure :: calculate => field_transfer_calculate
    
    procedure :: do_mapping => field_transfer_do_mapping
    
    procedure :: dfield_transfer_interpolate, zfield_transfer_interpolate
    generic :: interpolate => dfield_transfer_interpolate, zfield_transfer_interpolate
    
    procedure :: calculate_energy => field_transfer_calculate_energy
    
    procedure :: read_restart => field_transfer_read_restart
    
    procedure :: write_restart => field_transfer_write_restart
    
    procedure :: end => field_transfer_end
    
  end type field_transfer_t
 
contains
 
  subroutine field_transfer_init(this, gr, ndim)
    class(field_transfer_t), intent(inout) :: this
    type(grid_t), target,    intent(in)    :: gr
    integer,                 intent(in)    :: ndim
 
    push_sub(field_transfer_init)
 
    this%system_gr => gr
    this%ndim = ndim
    safe_allocate(this%system_field(1:gr%np, 1:ndim))
    this%system_field(:,:) = m_zero
 
    pop_sub(field_transfer_init)
  end subroutine field_transfer_init
 
  subroutine field_transfer_init_from_partner(this, partner_gr, partner_space, partner_namespace)
    class(field_transfer_t), intent(inout) :: this
    type(grid_t),            intent(in)    :: partner_gr
    class(space_t),          intent(in)    :: partner_space
    type(namespace_t),       intent(in)    :: partner_namespace
 
    push_sub(field_transfer_init_from_partner)
 
    safe_allocate(this%partner_field(1:partner_gr%np, 1:this%ndim))
    this%partner_field(:,:) = m_zero
    this%regridding => regridding_t(this%system_gr, partner_gr, partner_space, partner_namespace)
 
    pop_sub(field_transfer_init_from_partner)
  end subroutine field_transfer_init_from_partner
 
  subroutine field_transfer_init_interpolation(this, depth, label, cmplx)
    class(field_transfer_t), intent(inout) :: this
    integer,                 intent(in)    :: depth
    character(len=*),        intent(in)    :: label
    logical, optional,       intent(in)    :: cmplx
 
    push_sub(field_transfer_init_interpolation)
 
    this%interpolation => time_interpolation_t(this%system_gr%np, this%ndim, depth, &
      optional_default(cmplx, .false.), trim(label) // '-' // trim(this%partner%namespace%get()))
    this%interpolation_initialized = .true.
 
    pop_sub(field_transfer_init_interpolation)
  end subroutine field_transfer_init_interpolation
 
  subroutine field_transfer_end(this)
    class(field_transfer_t), intent(inout) :: this
 
    push_sub(field_transfer_end)
 
    call interaction_end(this)
    safe_deallocate_a(this%partner_field)
    safe_deallocate_a(this%system_field)
    safe_deallocate_p(this%regridding)
    safe_deallocate_p(this%interpolation)
 
    pop_sub(field_transfer_end)
  end subroutine field_transfer_end
 
  subroutine field_transfer_calculate(this)
    class(field_transfer_t), intent(inout) :: this
 
    push_sub(field_transfer_calculate)
 
    ! nothing to do here
    ! the mapping is done when the quantity is copied to the interaction
    ! for this interaction, we do not need input from the system, so the
    ! values do only change when the partner quantity changes
 
    pop_sub(field_transfer_calculate)
  end subroutine field_transfer_calculate
 
  subroutine field_transfer_do_mapping(this)
    class(field_transfer_t), intent(inout) :: this
 
 
    push_sub_with_profile(field_transfer_do_mapping)
 
    assert(this%interpolation_initialized)
 
    if (allocated(this%partner_field)) then
      call this%regridding%do_transfer(this%system_field, this%partner_field)
    end if
 
    call this%interpolation%add_time(this%partner%quantities(this%couplings_from_partner(1))%iteration%value(), &
      this%system_field)
 
    pop_sub_with_profile(field_transfer_do_mapping)
  end subroutine field_transfer_do_mapping
 
  subroutine dfield_transfer_interpolate(this, time, field)
    class(field_transfer_t),  intent(in)  :: this
    real(real64),             intent(in)  :: time
    real(real64), contiguous, intent(out) :: field(:, :)
 
 
    push_sub_with_profile(dfield_transfer_interpolate)
 
    call this%interpolation%interpolate(time, field)
 
    pop_sub_with_profile(dfield_transfer_interpolate)
  end subroutine dfield_transfer_interpolate
 
  subroutine zfield_transfer_interpolate(this, time, field)
    class(field_transfer_t),     intent(in)  :: this
    real(real64),                intent(in)  :: time
    complex(real64), contiguous, intent(out) :: field(:, :)
 
 
    push_sub_with_profile(zfield_transfer_interpolate)
 
    call this%interpolation%interpolate(time, field)
 
    pop_sub_with_profile(zfield_transfer_interpolate)
  end subroutine zfield_transfer_interpolate
 
  subroutine field_transfer_calculate_energy(this)
    class(field_transfer_t),    intent(inout) :: this
 
    push_sub(field_transfer_calculate_energy)
 
    ! interaction energy is zero, since it is only re-gridding the quantities of one system
    ! on the mesh of the other
    this%energy = m_zero
 
    pop_sub(field_transfer_calculate_energy)
  end subroutine field_transfer_calculate_energy
 
  subroutine field_transfer_read_restart(this, mesh, space, restart, err)
    class(field_transfer_t), intent(inout) :: this
    class(mesh_t),           intent(in)    :: mesh
    class(space_t),          intent(in)    :: space
    type(restart_t),         intent(in)    :: restart
    integer,                 intent(out)   :: err
 
    push_sub_with_profile(field_transfer_read_restart)
 
    call this%interpolation%read_restart(mesh, space, restart, err)
 
    pop_sub_with_profile(field_transfer_read_restart)
  end subroutine field_transfer_read_restart
 
  subroutine field_transfer_write_restart(this, mesh, space, restart, err)
    class(field_transfer_t), intent(inout) :: this
    class(mesh_t),           intent(in)    :: mesh
    class(space_t),          intent(in)    :: space
    type(restart_t),         intent(in)    :: restart
    integer,                 intent(out)   :: err
 
    push_sub_with_profile(field_transfer_write_restart)
 
    call this%interpolation%write_restart(mesh, space, restart, err)
 
    pop_sub_with_profile(field_transfer_write_restart)
  end subroutine field_transfer_write_restart
end module field_transfer_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: