sll_m_particle_group_base.F90

Go to the documentation of this file.

module sll_m_particle_group_base
 
  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#include "sll_memory.h"
#include "sll_working_precision.h"
 
  implicit none
 
  public :: &
       sll_c_particle_group_base, &
       sll_t_particle_array, &
       sll_t_species, &
       sll_f_index_1dto2d, &
       sll_f_index_1dto3d, &
       sll_f_index_2dto1d, &
       sll_f_index_3dto1d
 
  private
  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
 
 
 
  !============================================================================
  ! Particle species
  !============================================================================
  type :: sll_t_species
     character(len=64) :: name
     sll_real64        :: q    
     sll_real64        :: m    
 
   contains
     procedure         :: q_over_m
     procedure         :: init => initialize_species 
 
  end type sll_t_species
 
 
  !============================================================================
  ! Particle group
  !============================================================================
  type, abstract :: sll_c_particle_group_base
 
     class( sll_t_species ), allocatable :: species
     sll_int32                           :: id
     sll_int32                           :: n_particles 
     sll_int32                           :: n_total_particles 
     sll_int32                           :: n_weights 
 
 
   contains
     ! Getters ( for single particles )
     procedure( i_get_coords ), deferred :: get_x
     procedure( i_get_coords ), deferred :: get_v
     procedure( i_get_scalar ), deferred :: get_charge
     procedure( i_get_scalar ), deferred :: get_mass
     procedure( i_get_array  ), deferred :: get_weights
     procedure( get_scalar ), deferred :: get_common_weight
     procedure                           :: get_box
     procedure                           :: get_boxnd
     procedure                           :: get_xbox
     procedure                           :: get_patch
     procedure                           :: get_xpatch
 
     ! Getters ( for chunk of particles )
     ! All chunk-getters are calling the single versions by default
     ! We use pointers to avoid copying. Note that no setters are necessary since we use pointers to access the values.
     ! For chunks, only one chget_x is provided this gives the coordinates in the format that the positions are stored. 
     procedure                           :: chget_x
     procedure                           :: chget_v
     procedure                           :: chget_weights
     procedure                           :: chget_box
     procedure                           :: chget_boxnd
     procedure                           :: chget_patch
 
     ! Setters ( for single particles )
     procedure( i_set_coords ), deferred :: set_x
     procedure( i_set_coords ), deferred :: set_v
     procedure( i_set_array  ), deferred :: set_weights
     procedure( set_scalar ),   deferred :: set_common_weight
 
     procedure                           :: set_box
     procedure                           :: set_boxnd
     procedure                           :: set_patch
 
     procedure( empty ),        deferred :: free
 
     !    ! Getters for the whole group
     !    procedure( get_all_coords), deferred :: get_all_x
     !    procedure( get_all_coords), deferred :: get_all_v
 
     procedure                           :: print
     procedure                           :: read
 
  end type sll_c_particle_group_base
 
  !============================================================================
  ! Particle array
  !============================================================================
  type :: sll_t_particle_array
 
     sll_int32 :: n_species
     class(sll_c_particle_group_base), allocatable :: group(:)
 
  end type sll_t_particle_array
 
  !----------------------------------------------------------------------------
  abstract interface
     pure function i_get_int( self, i ) result( r )
       use sll_m_working_precision
       import sll_c_particle_group_base
       class( sll_c_particle_group_base ), intent( in ) :: self
       sll_int32                       ,   intent( in ) :: i
       sll_int32 :: r
     end function i_get_int
  end interface
 
  !----------------------------------------------------------------------------
  abstract interface
     pure function i_get_intnd( self, i ) result( r )
       use sll_m_working_precision
       import sll_c_particle_group_base
       class( sll_c_particle_group_base ), intent( in ) :: self
       sll_int32                       ,   intent( in ) :: i
       sll_int32 :: r(3)
     end function i_get_intnd
  end interface
 
  !----------------------------------------------------------------------------
  abstract interface
     pure function i_get_scalar( self, i , i_weight) result( r )
       use sll_m_working_precision
       import sll_c_particle_group_base
       class( sll_c_particle_group_base ), intent( in ) :: self
       sll_int32                       ,   intent( in ) :: i
       sll_int32, optional             ,   intent( in ) :: i_weight
       sll_real64 :: r
     end function i_get_scalar
  end interface
  !----------------------------------------------------------------------------
  abstract interface
     pure function get_scalar( self ) result(r)
       use sll_m_working_precision
       import sll_c_particle_group_base
       class( sll_c_particle_group_base ), intent( in ) :: self
       sll_real64 :: r
     end function get_scalar
  end interface
 
 
  !----------------------------------------------------------------------------
  abstract interface
     pure function i_get_coords( self, i ) result( r )
       use sll_m_working_precision
       import sll_c_particle_group_base
       class( sll_c_particle_group_base ), intent( in ) :: self
       sll_int32                       ,   intent( in ) :: i
       sll_real64                                       :: r(3)
     end function i_get_coords
  end interface
 
  !----------------------------------------------------------------------------
  abstract interface
     pure function i_get_array( self, i ) result( r )
       use sll_m_working_precision
       import sll_c_particle_group_base
       class( sll_c_particle_group_base ), intent( in ) :: self
       sll_int32                       ,   intent( in ) :: i
       sll_real64                                       :: r(self%n_weights)
     end function i_get_array
  end interface
 
  !----------------------------------------------------------------------------
  abstract interface
     subroutine i_set_coords( self, i, x )
       use sll_m_working_precision
       import sll_c_particle_group_base
       class( sll_c_particle_group_base ), intent( inout ) :: self
       sll_int32                         , intent( in    ) :: i
       sll_real64                        , intent( in    ) :: x(3)
     end subroutine i_set_coords
  end interface
 
  !----------------------------------------------------------------------------
  abstract interface
     subroutine i_set_scalar( self, i, x )
       use sll_m_working_precision
       import sll_c_particle_group_base
       class( sll_c_particle_group_base ), intent( inout ) :: self
       sll_int32                        , intent( in    ) :: i
       sll_real64                       , intent( in    ) :: x
     end subroutine i_set_scalar
  end interface
 
  !----------------------------------------------------------------------------
  abstract interface
     subroutine set_scalar( self, x )
       use sll_m_working_precision
       import sll_c_particle_group_base
       class( sll_c_particle_group_base ), intent( inout ) :: self
       sll_real64                        , intent( in    ) :: x
     end subroutine set_scalar
  end interface
 
  !----------------------------------------------------------------------------
  abstract interface
     subroutine i_set_array( self, i, x )
       use sll_m_working_precision
       import sll_c_particle_group_base
       class( sll_c_particle_group_base ), intent( inout ) :: self
       sll_int32                         , intent( in    ) :: i
       sll_real64                        , intent( in    ) :: x(self%n_weights)
     end subroutine i_set_array
  end interface
 
  !---------------------------------------------------------------------------!  
  abstract interface
     subroutine empty(self)
       import sll_c_particle_group_base
       class( sll_c_particle_group_base ), intent( inout ) :: self
 
     end subroutine empty
  end interface
 
contains
 
  !----------------------------------------------------------------------------
  pure function q_over_m( self ) result( r )
    class( sll_t_species ), intent( in ) :: self
    sll_real64 :: r
 
    r = self%q / self%m
  end function q_over_m
 
 
  !----------------------------------------------------------------------------
  subroutine initialize_species(&
       self, &
       species_charge,     &
       species_mass        &
       )
    class(sll_t_species), intent ( out ) :: self
    sll_real64,           intent ( in )  :: species_charge
    sll_real64,           intent ( in )  :: species_mass
 
 
    self%q = species_charge
    self%m = species_mass
 
  end subroutine initialize_species
 
 
 
  !----------------------------------------------------------------------------!
  ! Single particle gets and setters for boxes and patches
  !----------------------------------------------------------------------------!
 
  
  pure function get_box( self, i ) result( r )
    class(sll_c_particle_group_base), intent ( in ) :: self
    sll_int32,            intent ( in ) :: i    
 
    sll_int32 :: r
 
    r = 1
 
  end function get_box
 
  
  pure function get_boxnd( self, i ) result( r )
    class(sll_c_particle_group_base), intent ( in ) :: self
    sll_int32,            intent ( in ) :: i    
 
    sll_int32 :: r(3)
 
    r = 1
 
  end function get_boxnd
 
  
  pure function get_xbox( self, i ) result( r )
    class(sll_c_particle_group_base), intent ( in ) :: self
    sll_int32,                       intent ( in ) :: i    
 
    sll_real64 :: r(3)
 
    r = self%get_x( i )   
 
  end function get_xbox
 
  pure function get_patch( self, i ) result( r )
    class(sll_c_particle_group_base), intent ( in ) :: self
    sll_int32,            intent ( in ) :: i    
 
    sll_int32 :: r
 
    r = 1
 
  end function get_patch
 
  pure function get_xpatch( self, i ) result( r )
    class(sll_c_particle_group_base), intent ( in ) :: self
    sll_int32,                       intent ( in ) :: i    
 
    sll_real64 :: r(3)
 
    r = self%get_x( i )   
 
  end function get_xpatch
 
 
  subroutine set_box( self, i , box)
    class(sll_c_particle_group_base), intent ( in )   :: self
    sll_int32,                        intent ( in )   :: i    
    sll_int32,                        intent (   out) :: box 
 
 
  end subroutine set_box
 
  subroutine set_boxnd( self, i , box)
    class(sll_c_particle_group_base), intent ( in )   :: self
    sll_int32,                        intent ( in )   :: i    
    sll_int32,                        intent (   out) :: box(:) 
 
 
  end subroutine set_boxnd
 
 
  subroutine set_patch( self, i , box)
    class(sll_c_particle_group_base), intent ( in )   :: self
    sll_int32,                        intent ( in )   :: i    
    sll_int32,                        intent (   out) :: box 
 
 
  end subroutine set_patch
 
  !----------------------------------------------------------------------------!
  ! Getters for chunks of particles
  !----------------------------------------------------------------------------!
 
  
  subroutine chget_x( self, chunk, x )
    class(sll_c_particle_group_base), intent ( in ) :: self
    sll_int32,            intent ( in ) :: chunk(1:2)    
    sll_real64, pointer,    intent( out ) :: x(:,:)     
 
    sll_int32 :: i
 
    do i=chunk(1),chunk(2)
       x(:,i-chunk(1)+1) = self%get_x( i )
    end do
 
  end subroutine chget_x
 
  
  subroutine chget_v( self, chunk, v )
    class(sll_c_particle_group_base), intent ( in ) :: self
    sll_int32,            intent ( in ) :: chunk(1:2)    
    sll_real64, pointer,    intent( out ) :: v(:,:)     
 
    sll_int32 :: i
 
    do i=chunk(1),chunk(2)
       v(:,i-chunk(1)+1) = self%get_v( i )
    end do
 
  end subroutine chget_v
 
  
  subroutine chget_weights( self, chunk, weights )
    class(sll_c_particle_group_base), intent ( in ) :: self
    sll_int32,            intent ( in ) :: chunk(1:2)    
    sll_real64, pointer,    intent( out ) :: weights(:,:)     
 
    sll_int32 :: i
 
    do i=chunk(1),chunk(2)
       weights(:,i-chunk(1)+1) = self%get_weights( i )
    end do
 
  end subroutine chget_weights
 
  
  subroutine chget_box( self, chunk, box )
    class(sll_c_particle_group_base), intent ( in ) :: self
    sll_int32,            intent ( in ) :: chunk(1:2)    
    sll_int32, pointer,    intent( out ) :: box(:) 
 
    sll_int32 :: i
 
    do i=chunk(1),chunk(2)
       box(i-chunk(1)+1) = self%get_box( i )
    end do
 
  end subroutine chget_box
 
  
  subroutine chget_boxnd( self, chunk, boxnd )
    class(sll_c_particle_group_base), intent ( in ) :: self
    sll_int32,            intent ( in ) :: chunk(1:2)    
    sll_int32, pointer,    intent( out ) :: boxnd(:,:)    
 
    sll_int32 :: i
 
    do i=chunk(1),chunk(2)
       boxnd(:,i-chunk(1)+1) = self%get_boxnd( i )
    end do
 
  end subroutine chget_boxnd
 
  
  subroutine chget_patch( self, chunk, patch )
    class(sll_c_particle_group_base), intent ( in ) :: self
    sll_int32,            intent ( in ) :: chunk(1:2)    
    sll_int32, pointer,    intent( out ) :: patch(:) 
 
    sll_int32 :: i
 
    do i=chunk(1),chunk(2)
       patch(i-chunk(1)+1) = self%get_patch( i )
    end do
 
  end subroutine chget_patch
 
  subroutine print( self, filename )
    class(sll_c_particle_group_base), intent ( in ) :: self
    character(len=*), intent(in) :: filename
 
  end subroutine print
 
  subroutine read( self, filename )
    class(sll_c_particle_group_base), intent ( inout ) :: self
    character(len=*), intent(in) :: filename
 
  end subroutine read
 
  !----------------------------------------------------------------------------!
  ! Index conversion helper functions
  !----------------------------------------------------------------------------!
 
  pure function sll_f_index_1dto2d( num_pts, ind1d) result( ind2d )
    sll_int32, intent( in    ) :: num_pts(2)
    sll_int32, intent( in    ) :: ind1d
    sll_int32                  :: ind2d(2)
 
    ind2d(2) = ( ind1d/num_pts(1) )
    ind2d(1) = ind1d - ind2d(2)*num_pts(1) 
    ind2d(2) = ind2d(2)+1
 
  end function sll_f_index_1dto2d
 
  pure function sll_f_index_2dto1d( num_pts, ind2d) result( ind1d )
    sll_int32, intent( in    ) :: num_pts(2)
    sll_int32, intent( in    ) :: ind2d(2)
    sll_int32                  :: ind1d
 
 
    ind1d = ind2d(1)+ (ind2d(2)-1) * num_pts(1)
 
  end function sll_f_index_2dto1d
 
 
  pure function sll_f_index_1dto3d( num_pts, ind1d) result( ind3d )
    sll_int32, intent( in    ) :: num_pts(3)
    sll_int32, intent( in    ) :: ind1d
    sll_int32                  :: ind3d(3)
 
    sll_int32 :: ind
 
    ind3d(3) = ( ind1d/(num_pts(1)*num_pts(2)) )
    ind = ind1d - ind3d(3)*(num_pts(1)*num_pts(2))
    ind3d(3) = ind3d(3) +1
    ind3d(2) = ( ind/num_pts(1) )
    ind3d(1) = ind - ind3d(2)*num_pts(1) 
    ind3d(2) = ind3d(2)+1
 
  end function sll_f_index_1dto3d
 
  pure function sll_f_index_3dto1d( num_pts, ind3d) result( ind1d )
    sll_int32, intent( in    ) :: num_pts(3)
    sll_int32, intent( in    ) :: ind3d(3)
    sll_int32                  :: ind1d
 
 
    ind1d = ind3d(1) + (ind3d(2)-1) * num_pts(1) + (ind3d(3)-1)* num_pts(1)*num_pts(2)
 
  end function sll_f_index_3dto1d
 
 
end module sll_m_particle_group_base