Add support for extended particle range to the Fortran interfaces (#1331

)

* add support for extended particle range to the Fortran interfaces

* replace c_long -> amrex_long for Windows support

Src/F_Interfaces/Particle/AMReX_particlecontainer_fi.cpp

@@ -26,7 +26,7 @@ extern "C" {
 	delete particlecontainer;
     }
 
-    void amrex_fi_get_next_particle_id (int& id)
+    void amrex_fi_get_next_particle_id (Long& id)
     {
         id = FParticleContainer::ParticleType::NextID();
     }
@@ -35,7 +35,27 @@ extern "C" {
     {
         cpu = ParallelDescriptor::MyProc();
     }
-
+
+    void amrex_fi_get_particle_id(Long& id, const FParticleContainer::ParticleType* p)
+    {
+        id = p->id();
+    }
+
+    void amrex_fi_set_particle_id(const Long& id, FParticleContainer::ParticleType* p)
+    {
+        p->id() = id;
+    }
+
+    void amrex_fi_get_particle_cpu(int& cpu, const FParticleContainer::ParticleType* p)
+    {
+        cpu = p->cpu();
+    }
+
+    void amrex_fi_set_particle_cpu(const int& cpu, FParticleContainer::ParticleType* p)
+    {
+        p->cpu() = cpu;
+    }
+
     void amrex_fi_write_particles(FParticleContainer* particlecontainer,
                                   const char* dirname, const char* pname, int is_checkpoint)
     {
@@ -69,7 +89,7 @@ extern "C" {
             dp = nullptr;
         }
     }
-    
+
     void amrex_fi_add_particle_mfi(FParticleContainer* particlecontainer,
                                    int lev, MFIter* mfi, FParticleContainer::ParticleType* p)
     {
@@ -79,15 +99,15 @@ extern "C" {
         auto& particle_tile  = particle_level[std::make_pair(grid, tile)];
         particle_tile.push_back(*p);
     }
-    
+
     void amrex_fi_num_particles_mfi(FParticleContainer* particlecontainer,
                                     int lev, MFIter* mfi, Long& np)
     {
         const int grid = mfi->index();
         const int tile = mfi->LocalTileIndex();
         auto& particle_level = particlecontainer->GetParticles(lev);
         auto search = particle_level.find(std::make_pair(grid, tile));
-        if (search != particle_level.end()) {            
+        if (search != particle_level.end()) {
             auto& particle_tile = search->second;
             np = particle_tile.numParticles();
         } else {
@@ -114,25 +134,25 @@ extern "C" {
             dp = nullptr;
         }
     }
-    
+
     void amrex_fi_add_particle_i(FParticleContainer* particlecontainer,
                                  int lev, int grid, int tile, FParticleContainer::ParticleType* p)
     {
         auto& particle_level = particlecontainer->GetParticles(lev);
         auto& particle_tile  = particle_level[std::make_pair(grid, tile)];
         particle_tile.push_back(*p);
     }
-    
+
     void amrex_fi_num_particles_i(FParticleContainer* particlecontainer,
                                   int lev, int grid, int tile, Long& np)
     {
         auto& particle_level = particlecontainer->GetParticles(lev);
         auto search = particle_level.find(std::make_pair(grid, tile));
-        if (search != particle_level.end()) {            
+        if (search != particle_level.end()) {
             auto& particle_tile = search->second;
             np = particle_tile.numParticles();
         } else {
             np = 0;
         }
-    }    
+    }
 }

Src/F_Interfaces/Particle/AMReX_particlecontainer_mod.F90

@@ -4,15 +4,17 @@ module amrex_particlecontainer_module
   use amrex_base_module
   use amrex_string_module
   use amrex_fort_module, only: amrex_particle_real, amrex_long
-  
+
   implicit none
 
   private
 
   ! public routines
   public :: amrex_particlecontainer_build, amrex_particlecontainer_destroy
   public :: amrex_get_next_particle_id, amrex_get_cpu
-
+  public :: amrex_get_particle_id, amrex_set_particle_id
+  public :: amrex_get_particle_cpu, amrex_set_particle_cpu
+
   type, bind(C), public :: amrex_particle
      real(amrex_particle_real)    :: pos(AMREX_SPACEDIM) !< Position
      real(amrex_particle_real)    :: vel(AMREX_SPACEDIM) !< Particle velocity
@@ -56,15 +58,43 @@ end subroutine amrex_fi_delete_particlecontainer
      subroutine amrex_fi_get_next_particle_id (id) bind(c)
        import
        implicit none
-       integer(c_int) id
+       integer(amrex_long) id
      end subroutine amrex_fi_get_next_particle_id
 
      subroutine amrex_fi_get_cpu (cpu) bind(c)
        import
        implicit none
        integer(c_int) cpu
      end subroutine amrex_fi_get_cpu
-
+
+     subroutine amrex_fi_get_particle_id (id, p) bind(c)
+       import
+       implicit none
+       integer(amrex_long) id
+       type(c_ptr),    value :: p
+     end subroutine amrex_fi_get_particle_id
+
+     subroutine amrex_fi_set_particle_id (id, p) bind(c)
+       import
+       implicit none
+       integer(amrex_long) id
+       type(c_ptr),    value :: p
+     end subroutine amrex_fi_set_particle_id
+
+     subroutine amrex_fi_get_particle_cpu (cpu, p) bind(c)
+       import
+       implicit none
+       integer(c_int) cpu
+       type(c_ptr),    value :: p
+     end subroutine amrex_fi_get_particle_cpu
+
+     subroutine amrex_fi_set_particle_cpu (cpu, p) bind(c)
+       import
+       implicit none
+       integer(c_int) cpu
+       type(c_ptr),    value :: p
+     end subroutine amrex_fi_set_particle_cpu
+
      subroutine amrex_fi_write_particles (pc, dirname, pname, is_checkpoint) bind(c)
        import
        implicit none
@@ -97,7 +127,7 @@ subroutine amrex_fi_add_particle_mfi(pc, lev, mfi, p) bind(c)
        type(c_ptr),    value :: pc, mfi
        type(c_ptr),    value :: p
      end subroutine amrex_fi_add_particle_mfi
-     
+
      subroutine amrex_fi_num_particles_mfi(pc, lev, mfi, np) bind(c)
        import
        implicit none
@@ -122,15 +152,15 @@ subroutine amrex_fi_add_particle_i(pc, lev, grid, tile, p) bind(c)
        type(c_ptr),    value :: pc
        type(c_ptr),    value :: p
      end subroutine amrex_fi_add_particle_i
-     
+
      subroutine amrex_fi_num_particles_i(pc, lev, grid, tile, np) bind(c)
        import
        implicit none
        integer(c_int), value :: lev, grid, tile
        type(c_ptr),    value :: pc
        integer(amrex_long)   :: np
      end subroutine amrex_fi_num_particles_i
-     
+
   end interface
 
 contains
@@ -148,7 +178,7 @@ subroutine amrex_particlecontainer_destroy (this)
   end subroutine amrex_particlecontainer_destroy
 
   function amrex_get_next_particle_id() result(id)
-    integer(c_int) :: id
+    integer(amrex_long) :: id
     call amrex_fi_get_next_particle_id(id)
   end function amrex_get_next_particle_id
 
@@ -157,8 +187,48 @@ function amrex_get_cpu() result(cpu)
     call amrex_fi_get_cpu(cpu)
   end function amrex_get_cpu
 
+  subroutine amrex_get_particle_id (id, particle)
+    integer(amrex_long), intent(inout) :: id
+    type(amrex_particle), intent(in), target :: particle
+    type(amrex_particle), pointer :: ptr
+    type(c_ptr) :: dp
+    ptr => particle
+    dp = c_loc(ptr)
+    call amrex_fi_get_particle_id(id, dp)
+  end subroutine amrex_get_particle_id
+
+  subroutine amrex_set_particle_id (id, particle)
+    integer(amrex_long), intent(in) :: id
+    type(amrex_particle), intent(inout), target :: particle
+    type(amrex_particle), pointer :: ptr
+    type(c_ptr) :: dp
+    ptr => particle
+    dp = c_loc(ptr)
+    call amrex_fi_set_particle_id(id, dp)
+  end subroutine amrex_set_particle_id
+
+  subroutine amrex_get_particle_cpu (cpu, particle)
+    integer(c_int), intent(inout) :: cpu
+    type(amrex_particle), intent(in), target :: particle
+    type(amrex_particle), pointer :: ptr
+    type(c_ptr) :: dp
+    ptr => particle
+    dp = c_loc(ptr)
+    call amrex_fi_get_particle_cpu(cpu, dp)
+  end subroutine amrex_get_particle_cpu
+
+  subroutine amrex_set_particle_cpu (cpu, particle)
+    integer(c_int), intent(in) :: cpu
+    type(amrex_particle), intent(inout), target :: particle
+    type(amrex_particle), pointer :: ptr
+    type(c_ptr) :: dp
+    ptr => particle
+    dp = c_loc(ptr)
+    call amrex_fi_set_particle_cpu(cpu, dp)
+  end subroutine amrex_set_particle_cpu
+
   subroutine amrex_write_particles (this, dirname, pname, is_checkpoint)
-    class(amrex_particlecontainer), intent(inout) :: this    
+    class(amrex_particlecontainer), intent(inout) :: this
     character(len=*), intent(in) :: dirname
     character(len=*), intent(in) :: pname
     logical, intent(in)          :: is_checkpoint
@@ -169,13 +239,13 @@ subroutine amrex_write_particles (this, dirname, pname, is_checkpoint)
     else
        is_check_flag = 0
     end if
-    
+
     call amrex_fi_write_particles(this%p, amrex_string_f_to_c(dirname), &
          amrex_string_f_to_c(pname), is_check_flag)
   end subroutine amrex_write_particles
 
   subroutine amrex_particle_redistribute (this, lev_min,lev_max,nghost)
-    class(amrex_particlecontainer), intent(inout) :: this    
+    class(amrex_particlecontainer), intent(inout) :: this
     integer, optional, intent(in) :: lev_min, lev_max, nghost
     integer(c_int) :: default_min, default_max, default_ng
     default_min = 0
@@ -189,7 +259,7 @@ subroutine amrex_particle_redistribute (this, lev_min,lev_max,nghost)
   end subroutine amrex_particle_redistribute
 
   subroutine amrex_add_particle_mfi(this, lev, mfi, particle)
-    class(amrex_particlecontainer), intent(inout) :: this    
+    class(amrex_particlecontainer), intent(inout) :: this
     integer(c_int),       intent(in)           :: lev
     type(amrex_mfiter),   intent(in)           :: mfi
     type(amrex_particle), intent(in), target :: particle
@@ -199,7 +269,7 @@ subroutine amrex_add_particle_mfi(this, lev, mfi, particle)
     dp = c_loc(ptr)
     call amrex_fi_add_particle_mfi(this%p, lev, mfi%p, dp)
   end subroutine amrex_add_particle_mfi
-  
+
   function amrex_get_particles_mfi(this, lev, mfi) result(particles)
     class(amrex_particlecontainer), intent(inout) :: this
     integer(c_int),     intent(in) :: lev
@@ -220,7 +290,7 @@ function amrex_num_particles_mfi(this, lev, mfi) result(np)
   end function amrex_num_particles_mfi
 
   subroutine amrex_add_particle_i(this, lev, grid, tile, particle)
-    class(amrex_particlecontainer), intent(inout) :: this    
+    class(amrex_particlecontainer), intent(inout) :: this
     integer(c_int),       intent(in)           :: lev, grid, tile
     type(amrex_particle), intent(in), target :: particle
     type(amrex_particle), pointer :: ptr
@@ -229,7 +299,7 @@ subroutine amrex_add_particle_i(this, lev, grid, tile, particle)
     dp = c_loc(ptr)
     call amrex_fi_add_particle_i(this%p, lev, grid, tile, dp)
   end subroutine amrex_add_particle_i
-  
+
   function amrex_get_particles_i(this, lev, grid, tile) result(particles)
     class(amrex_particlecontainer), intent(inout) :: this
     integer(c_int),     intent(in) :: lev, grid, tile
@@ -246,6 +316,6 @@ function amrex_num_particles_i(this, lev, grid, tile) result(np)
     integer(amrex_long) :: np
     call amrex_fi_num_particles_i(this%p, lev, grid, tile, np)
   end function amrex_num_particles_i
-  
+
 end module amrex_particlecontainer_module
 

Tutorials/FortranInterface/Advection_F/Exec/SingleVortex/Prob_2d.f90

@@ -51,7 +51,7 @@ subroutine init_part_data(pc, lev, mfi, lo, hi, dx, prob_lo)
 
     use amrex_fort_module, only : amrex_spacedim, amrex_real
     use amrex_particlecontainer_module, only: amrex_particlecontainer, amrex_particle, &
-         amrex_get_next_particle_id, amrex_get_cpu
+         amrex_get_next_particle_id, amrex_get_cpu, amrex_set_particle_id, amrex_set_particle_cpu
     use amrex_multifab_module, only : amrex_mfiter
 
     implicit none
@@ -60,7 +60,7 @@ subroutine init_part_data(pc, lev, mfi, lo, hi, dx, prob_lo)
     type(amrex_mfiter), intent(in) :: mfi
     integer, intent(in) :: lo(2), hi(2)
     real(amrex_real), intent(in) :: dx(2), prob_lo(2)
-    
+
     integer          :: i,j
     real(amrex_real) :: x,y
     type(amrex_particle) :: p
@@ -75,11 +75,11 @@ subroutine init_part_data(pc, lev, mfi, lo, hi, dx, prob_lo)
 
           p%vel = 0.d0
 
-          p%id  = amrex_get_next_particle_id()
-          p%cpu = amrex_get_cpu()
+          call amrex_set_particle_id(amrex_get_next_particle_id(), p)
+          call amrex_set_particle_cpu(amrex_get_cpu(), p)
 
           call pc%add_particle(lev, mfi, p)
-          
+
        end do
     end do
 

Tutorials/FortranInterface/Advection_F/Exec/SingleVortex/Prob_3d.f90

@@ -69,7 +69,7 @@ subroutine init_part_data(pc, lev, mfi, lo, hi, dx, prob_lo)
 
     use amrex_fort_module, only : amrex_spacedim, amrex_real
     use amrex_particlecontainer_module, only: amrex_particlecontainer, amrex_particle, &
-         amrex_get_next_particle_id, amrex_get_cpu
+         amrex_get_next_particle_id, amrex_get_cpu, amrex_set_particle_id, amrex_set_particle_cpu
     use amrex_multifab_module, only : amrex_mfiter
 
     implicit none
@@ -93,18 +93,18 @@ subroutine init_part_data(pc, lev, mfi, lo, hi, dx, prob_lo)
              p%pos(1) = x
              p%pos(2) = y
              p%pos(3) = x
-             
+
              p%vel = 0.d0
 
-             p%id  = amrex_get_next_particle_id()
-             p%cpu = amrex_get_cpu()
-             
+             call amrex_set_particle_id(amrex_get_next_particle_id(), p)
+             call amrex_set_particle_cpu(amrex_get_cpu(), p)
+
              call pc%add_particle(lev, mfi, p)
-             
+
           end do
        end do
     end do
-    
+
   end subroutine init_part_data
 
 end module prob_module