Changeset 0a94e13 in flexpart.git for src/mpi_mod.f90

Timestamp:

May 6, 2019, 11:43:21 AM (5 years ago)

Author:

Espen Sollum ATMOS <eso@…>

Branches:

master, 10.4.1_pesei, GFS_025, bugfixes+enhancements, dev, release-10, release-10.4.1, scaling-bug

Children:

0c8c7f2

Parents:

328fdf9

Message:

Added ipout=3 option for time averaged particle output

File:

• src/mpi_mod.f90 (modified) (11 diffs, 1 prop)

src/mpi_mod.f90

@@ -88 +88 @@
 ! Variables for MPI processes in the 'particle' group
   integer, allocatable, dimension(:) :: mp_partgroup_rank
+  integer, allocatable, dimension(:) :: npart_per_process
   integer :: mp_partgroup_comm, mp_partgroup_pid, mp_partgroup_np
 
@@ -125 +126 @@
 ! mp_time_barrier   Measure MPI barrier time
 ! mp_exact_numpart  Use an extra MPI communication to give the exact number of particles
-!                   to standard output (this does *not* otherwise affect the simulation)
-! mp_rebalance      Attempt to rebalance particle between processes
+!                   to standard output (this does not otherwise affect the simulation)
   logical, parameter :: mp_dbg_mode = .false.
   logical, parameter :: mp_dev_mode = .false.
@@ -133 +133 @@
   logical, parameter :: mp_measure_time=.false.
   logical, parameter :: mp_exact_numpart=.true.
-  logical, parameter :: mp_rebalance=.true.
 
 ! for measuring CPU/Wall time
@@ -146 +145 @@
   real(dp),private :: mp_getfields_wtime_beg, mp_getfields_wtime_end, mp_getfields_wtime_total=0.
   real(sp),private :: mp_getfields_time_beg, mp_getfields_time_end, mp_getfields_time_total=0.
-!  real(dp),private :: mp_readwind_wtime_beg, mp_readwind_wtime_end, mp_readwind_wtime_total=0.
-!  real(sp),private :: mp_readwind_time_beg, mp_readwind_time_end, mp_readwind_time_total=0.
+  real(dp),private :: mp_readwind_wtime_beg, mp_readwind_wtime_end, mp_readwind_wtime_total=0.
+  real(sp),private :: mp_readwind_time_beg, mp_readwind_time_end, mp_readwind_time_total=0.
   real(dp),private :: mp_io_wtime_beg, mp_io_wtime_end, mp_io_wtime_total=0.
   real(sp),private :: mp_io_time_beg, mp_io_time_end, mp_io_time_total=0.
@@ -367 +366 @@
     end if
 
+! Allocate array for number of particles per process    
+    allocate(npart_per_process(0:mp_partgroup_np-1))
+
 ! Write whether MPI_IN_PLACE is used or not
 #ifdef USE_MPIINPLACE
@@ -607 +609 @@
     integer :: i,jj,nn, num_part=1,m,imin, num_trans
     logical :: first_iter
-    integer,allocatable,dimension(:) :: numparticles_mpi, idx_arr
+    integer,allocatable,dimension(:) :: idx_arr
     real,allocatable,dimension(:) :: sorted ! TODO: we don't really need this
 
@@ -616 +618 @@
 ! All processes exchange information on number of particles
 !****************************************************************************
-    allocate(numparticles_mpi(0:mp_partgroup_np-1), &
-         &idx_arr(0:mp_partgroup_np-1), sorted(0:mp_partgroup_np-1))
-
-    call MPI_Allgather(numpart, 1, MPI_INTEGER, numparticles_mpi, &
+    allocate( idx_arr(0:mp_partgroup_np-1), sorted(0:mp_partgroup_np-1))
+
+    call MPI_Allgather(numpart, 1, MPI_INTEGER, npart_per_process, &
          & 1, MPI_INTEGER, mp_comm_used, mp_ierr)
 
@@ -625 +626 @@
 ! Sort from lowest to highest
 ! Initial guess: correct order
-    sorted(:) = numparticles_mpi(:)
+    sorted(:) = npart_per_process(:)
     do i=0, mp_partgroup_np-1
       idx_arr(i) = i
     end do
+
+! Do not rebalance particles for ipout=3    
+    if (ipout.eq.3) return
 
 ! For each successive element in index array, see if a lower value exists
@@ -654 +658 @@
     m=mp_partgroup_np-1 ! index for last sorted process (most particles)
     do i=0,mp_partgroup_np/2-1
-      num_trans = numparticles_mpi(idx_arr(m)) - numparticles_mpi(idx_arr(i))
+      num_trans = npart_per_process(idx_arr(m)) - npart_per_process(idx_arr(i))
       if (mp_partid.eq.idx_arr(m).or.mp_partid.eq.idx_arr(i)) then
-        if ( numparticles_mpi(idx_arr(m)).gt.mp_min_redist.and.&
-             & real(num_trans)/real(numparticles_mpi(idx_arr(m))).gt.mp_redist_fract) then
+        if ( npart_per_process(idx_arr(m)).gt.mp_min_redist.and.&
+             & real(num_trans)/real(npart_per_process(idx_arr(m))).gt.mp_redist_fract) then
 ! DBG
-          ! write(*,*) 'mp_partid, idx_arr(m), idx_arr(i), mp_min_redist, num_trans, numparticles_mpi', &
-          !      &mp_partid, idx_arr(m), idx_arr(i), mp_min_redist, num_trans, numparticles_mpi
+          ! write(*,*) 'mp_partid, idx_arr(m), idx_arr(i), mp_min_redist, num_trans, npart_per_process', &
+          !      &mp_partid, idx_arr(m), idx_arr(i), mp_min_redist, num_trans, npart_per_process
 ! DBG
           call mpif_redist_part(itime, idx_arr(m), idx_arr(i), num_trans/2)
@@ -668 +672 @@
     end do
 
-    deallocate(numparticles_mpi, idx_arr, sorted)
+    deallocate(idx_arr, sorted)
 
   end subroutine mpif_calculate_part_redist
@@ -2716 +2720 @@
       end if
 
-!    case ('readwind')
-!      if (imode.eq.0) then
-!        call cpu_time(mp_readwind_time_beg)
-!        mp_readwind_wtime_beg = mpi_wtime()
-!      else
-!        call cpu_time(mp_readwind_time_end)
-!        mp_readwind_wtime_end = mpi_wtime()
-!
-!        mp_readwind_time_total = mp_readwind_time_total + &
-!             &(mp_readwind_time_end - mp_readwind_time_beg)
-!        mp_readwind_wtime_total = mp_readwind_wtime_total + &
-!             &(mp_readwind_wtime_end - mp_readwind_wtime_beg)
-!      end if
+   case ('readwind')
+     if (imode.eq.0) then
+       call cpu_time(mp_readwind_time_beg)
+       mp_readwind_wtime_beg = mpi_wtime()
+     else
+       call cpu_time(mp_readwind_time_end)
+       mp_readwind_wtime_end = mpi_wtime()
+
+       mp_readwind_time_total = mp_readwind_time_total + &
+            &(mp_readwind_time_end - mp_readwind_time_beg)
+       mp_readwind_wtime_total = mp_readwind_wtime_total + &
+            &(mp_readwind_wtime_end - mp_readwind_wtime_beg)
+     end if
 
     case ('commtime')