sll_m_pic_poisson_2d.F90

Go to the documentation of this file.

 
 
module sll_m_pic_poisson_2d
#include "sll_assert.h"
#include "sll_working_precision.h"
 
  use sll_m_pic_poisson_base, only : &
       sll_c_pic_poisson
  use sll_m_particle_mesh_coupling_base_1d, only : &
       sll_c_particle_mesh_coupling_1d
  use sll_m_poisson_2d_base, only : &
       sll_c_poisson_2d_base, sll_i_function_of_position
  use sll_m_collective, only : &
       sll_v_world_collective, sll_o_collective_allreduce
  use mpi, only: &
       mpi_sum
 
 
  implicit none
 
  public :: sll_t_pic_poisson_2d, &
       sll_s_new_pic_poisson_2d
 
  private
 
  type, extends(sll_c_pic_poisson) :: sll_t_pic_poisson_2d
     
     sll_int32 :: no_gridpts(2)
     sll_int32 :: no_dofs
 
     class(sll_c_particle_mesh_coupling_1d), pointer :: kernel
     class(sll_c_poisson_2d_base), pointer :: poisson
     sll_real64, allocatable               :: rho_dofs(:) 
     sll_real64, allocatable               :: rho_dofs_local(:) 
     sll_real64, allocatable               :: rho_analyt_dofs(:) 
     sll_real64, allocatable               :: efield_dofs(:,:) 
     sll_real64, allocatable               :: phi_dofs(:) 
     sll_real64, allocatable               :: rho2d(:,:) 
     sll_real64, allocatable               :: efield1(:,:) 
     sll_real64, allocatable               :: efield2(:,:) 
     sll_real64, allocatable               :: phi2d(:,:) 
 
     logical                               :: rho_collected
 
     contains
       procedure :: add_charge_single => add_charge_single_2d 
       procedure :: reset => reset_2d 
       procedure :: evaluate_rho_single => evaluate_rho_single_2d 
       procedure :: evaluate_phi_single => evaluate_phi_single_2d 
       procedure :: evaluate_field_single => evaluate_field_single_2d 
       procedure :: solve => solve_2d 
       procedure :: solve_phi => solve_phi_2d 
       procedure :: solve_fields => solve_fields_2d 
       procedure :: add_analytic_charge => add_analytic_charge_2d 
       procedure :: set_analytic_charge => set_analytic_charge_2d  
       procedure :: compute_field_energy => compute_field_energy_2d 
       procedure :: init => init_pic_poisson_2d 
       procedure :: free => free_pic_poisson_2d 
 
 
    end type sll_t_pic_poisson_2d
 
contains
 
  subroutine add_charge_single_2d(self, position, marker_charge)
    class(sll_t_pic_poisson_2d), intent( inout ) :: self
    sll_real64,                  intent( in )    :: position(self%dim) 
    sll_real64,                  intent( in )    :: marker_charge 
 
    call self%kernel%add_charge( position, marker_charge, self%rho_dofs_local )
       
 
  end subroutine add_charge_single_2d
  
  subroutine evaluate_rho_single_2d(self, position, func_value)
    class(sll_t_pic_poisson_2d), intent( inout ) :: self
    sll_real64,                  intent( in )    :: position(self%dim) 
    sll_real64,                  intent(out)     :: func_value 
 
    if (self%rho_collected .EQV. .false.) then
       self%rho_collected = .true.
       self%rho_dofs = 0.0_f64
       call sll_o_collective_allreduce( sll_v_world_collective, self%rho_dofs_local, &
            self%no_dofs, mpi_sum, self%rho_dofs)
    end if
 
    call self%kernel%evaluate( position, self%rho_dofs, func_value)
 
  end subroutine evaluate_rho_single_2d
 
  subroutine evaluate_phi_single_2d(self, position, func_value)
    class(sll_t_pic_poisson_2d), intent( inout ) :: self
    sll_real64,                intent( in ) :: position(self%dim) 
    sll_real64, intent(out) :: func_value 
 
    call self%kernel%evaluate( position, self%phi_dofs, func_value)
 
  end subroutine evaluate_phi_single_2d
 
  subroutine evaluate_field_single_2d(self, position, components, func_value)
    class(sll_t_pic_poisson_2d), intent( inout ) :: self
    sll_int32,                   intent(in )     :: components(:)
    sll_real64,                  intent( in )    :: position(self%dim) 
    sll_real64,                  intent(out)     :: func_value(:)
 
    call self%kernel%evaluate_multiple( position, components, self%efield_dofs, &
         func_value)
 
  end subroutine evaluate_field_single_2d
 
 
  subroutine solve_2d(self)
    class(sll_t_pic_poisson_2d), intent( inout ) :: self
 
    call self%solve_phi()
    call self%solve_fields()
    
  end subroutine solve_2d
 
  subroutine solve_phi_2d(self)
    class(sll_t_pic_poisson_2d), intent( inout ) :: self
 
    if (self%rho_collected .EQV. .false.) then
       self%rho_collected = .true.
       self%rho_dofs = 0.0_f64
       call sll_o_collective_allreduce( sll_v_world_collective, self%rho_dofs_local, &
            self%no_dofs, mpi_sum, self%rho_dofs)
    end if
    self%rho2d = reshape(self%rho_dofs, self%no_gridpts)
    call self%poisson%compute_phi_from_rho(self%phi2d, self%rho2d)
    self%phi_dofs = reshape(self%phi2d, [self%no_dofs])
 
  end subroutine solve_phi_2d
 
  subroutine solve_fields_2d(self)
    class(sll_t_pic_poisson_2d), intent( inout ) :: self
 
    if (self%rho_collected .EQV. .false.) then
       self%rho_collected = .true.
       self%rho_dofs = 0.0_f64
       call sll_o_collective_allreduce( sll_v_world_collective, self%rho_dofs_local, &
            self%no_dofs, mpi_sum, self%rho_dofs)
    end if
    self%rho2d = reshape(self%rho_dofs, self%no_gridpts)
    call self%poisson%compute_E_from_rho(self%efield1, self%efield2, self%rho2d)
    self%efield_dofs(:,1) = reshape(self%efield1, [self%no_dofs])
    self%efield_dofs(:,2) = reshape(self%efield2, [self%no_dofs])
 
  end subroutine solve_fields_2d
 
  subroutine reset_2d(self)
    class(sll_t_pic_poisson_2d), intent( inout ) :: self
 
    self%rho_dofs_local = 0.0_f64
    self%rho_dofs = 0.0_f64
    self%rho_collected = .false.
 
  end subroutine reset_2d
 
  subroutine add_analytic_charge_2d(self, factor_present, factor_analytic)   
    class(sll_t_pic_poisson_2d), intent( inout ) :: self
    sll_real64, intent( in ) :: factor_present 
    sll_real64, intent( in ) :: factor_analytic 
 
    self%rho_dofs = factor_present * self%rho_dofs + &
         factor_analytic * self%rho_analyt_dofs
 
  end subroutine add_analytic_charge_2d
 
  subroutine set_analytic_charge_2d(self, func)
    class( sll_t_pic_poisson_2d ), intent( inout )    :: self
    procedure(sll_i_function_of_position)                :: func
 
    call self%poisson%compute_rhs_from_function(func, self%rho_analyt_dofs)
 
  end subroutine set_analytic_charge_2d
 
  function compute_field_energy_2d(self, component) result(energy)
    class(sll_t_pic_poisson_2d), intent( in ) :: self
    sll_int32,                    intent( in ) :: component 
    sll_real64                                 :: energy 
 
 
    if (component == 1) then
       energy = self%poisson%l2norm_squared(self%efield1)
    elseif (component == 2) then
       energy = self%poisson%l2norm_squared(self%efield2)
    end if
 
  end function compute_field_energy_2d
 
  !-------------------------------------------------------------------------------------------
  
  subroutine init_pic_poisson_2d(self, no_gridpts, poisson, kernel)
    class( sll_t_pic_poisson_2d),           intent(out) :: self
    sll_int32,                              intent(in)  :: no_gridpts(2)
    class( sll_c_poisson_2d_base), pointer, intent(in)  :: poisson
    class( sll_c_particle_mesh_coupling_1d), pointer, intent(in)  :: kernel
 
    !local variables
    sll_int32 :: ierr
 
    self%dim = 1
    self%no_gridpts = no_gridpts
    self%no_dofs = product(no_gridpts)
    self%rho_collected = .false.
    
    self%poisson => poisson
    self%kernel => kernel
 
    allocate(self%rho_dofs(self%no_dofs), stat=ierr)
    sll_assert( ierr == 0 )
    allocate(self%rho_dofs_local(self%no_dofs), stat=ierr)
    sll_assert( ierr == 0 )
    allocate(self%rho_analyt_dofs(self%no_dofs), stat=ierr)
    sll_assert( ierr == 0 )
    allocate(self%efield_dofs(self%no_dofs, 2), stat=ierr)
    sll_assert( ierr == 0 )
    allocate(self%phi_dofs(self%no_dofs), stat=ierr)
    sll_assert( ierr == 0 )
    allocate(self%rho2d(self%no_gridpts(1), self%no_gridpts(2)), stat=ierr)
    sll_assert( ierr == 0 )
    allocate(self%efield1(self%no_gridpts(1), self%no_gridpts(2)), stat=ierr)
    sll_assert( ierr == 0 )
    allocate(self%efield2(self%no_gridpts(1), self%no_gridpts(2)), stat=ierr)  
    sll_assert( ierr == 0 )  
    allocate(self%phi2d(self%no_gridpts(1), self%no_gridpts(2)), stat=ierr)
    sll_assert( ierr == 0 )
 
  end subroutine init_pic_poisson_2d
 
  subroutine free_pic_poisson_2d(self)
    class( sll_t_pic_poisson_2d), intent(inout) :: self
 
    deallocate(self%rho_dofs)
    deallocate(self%rho_dofs_local)
    deallocate(self%rho_analyt_dofs)
    deallocate(self%efield_dofs)
    deallocate(self%phi_dofs)
    deallocate(self%rho2d)
    deallocate(self%efield1)
    deallocate(self%efield2)
    deallocate(self%phi2d)
    self%poisson => null()
    self%kernel => null()
 
  end subroutine free_pic_poisson_2d
 
 
  subroutine sll_s_new_pic_poisson_2d(pic_poisson, no_gridpts, poisson, kernel)    
    class( sll_c_pic_poisson),     pointer, intent(out) :: pic_poisson
    sll_int32,                              intent(in)  :: no_gridpts(2)
    class( sll_c_poisson_2d_base), pointer, intent(in)  :: poisson
    class( sll_c_particle_mesh_coupling_1d), pointer, intent(in)  :: kernel
 
    !local variables
    sll_int32 :: ierr
 
    allocate( sll_t_pic_poisson_2d :: pic_poisson, stat=ierr)
    select type( pic_poisson)
    type is ( sll_t_pic_poisson_2d )
       call pic_poisson%init( no_gridpts, poisson, kernel)
    end select
 
  end subroutine sll_s_new_pic_poisson_2d
 
end module sll_m_pic_poisson_2d