Changeset 16b61a5 in flexpart.git for src/mpi_mod.f90

Timestamp:

Oct 14, 2016, 3:19:00 PM (8 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, univie

Children:

4c64400

Parents:

861805a

Message:

Reworked the domain-filling option (MPI). Fixed a slow loop which had errors in loop counter (MPI)

File:

• src/mpi_mod.f90 (modified) (13 diffs)

src/mpi_mod.f90

@@ -122 +122 @@
   logical, parameter :: mp_dev_mode = .false.
   logical, parameter :: mp_dbg_out = .false.
-  logical, parameter :: mp_time_barrier=.false.
+  logical, parameter :: mp_time_barrier=.true.
   logical, parameter :: mp_measure_time=.false.
   logical, parameter :: mp_exact_numpart=.true.
@@ -251 +251 @@
         write(*,FMT='(80("#"))')
       end if
-      lmp_sync=.true. ! :DBG: eso fix this...
+      lmp_sync=.true.
     end if
 
@@ -261 +261 @@
 !**********************************************************************
 
+!    id_read = min(mp_np-1, 1)
     id_read = mp_np-1
 
@@ -486 +487 @@
     integer :: i,jj, addone
 
+! Exit if too many particles
+    if (num_part.gt.maxpart_mpi) then
+      write(*,*) '#####################################################'
+      write(*,*) '#### ERROR - TOTAL NUMBER OF PARTICLES REQUIRED  ####'
+      write(*,*) '#### EXCEEDS THE MAXIMUM ALLOWED NUMBER. REDUCE  ####'
+      write(*,*) '#### EITHER NUMBER OF PARTICLES PER RELEASE POINT####'
+      write(*,*) '#### OR INCREASE MAXPART.                        ####'
+      write(*,*) '#####################################################'
+!      call MPI_FINALIZE(mp_ierr)
+      stop
+    end if
+
+
 ! Time for MPI communications
 !****************************
@@ -527 +541 @@
 
     if (mp_measure_time) call mpif_mtime('commtime',1)
-    write(*,*) "PID ", mp_partid, "ending MPI_Scatter operation"
 
     goto 601
@@ -535 +548 @@
 
 ! After the transfer of particles it it possible that the value of
-! "numpart" is larger than the actual, so we reduce it if there are
+! "numpart" is larger than the actual used, so we reduce it if there are
 ! invalid particles at the end of the arrays
 601 do i=num_part, 1, -1
@@ -628 +641 @@
         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
+! 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
+! DBG
           call mpif_redist_part(itime, idx_arr(m), idx_arr(i), num_trans/2)
         end if
@@ -661 +678 @@
     integer :: i, j, minpart, ipart, maxnumpart
  
+! Check for invalid input arguments
+!**********************************
+ if (src_proc.eq.dest_proc) then
+   write(*,*) '<mpi_mod::mpif_redist_part>: Error: &
+        &src_proc.eq.dest_proc' 
+   stop
+ end if
+
 ! Measure time for MPI communications
 !************************************
@@ -674 +699 @@
       ul=numpart
 
-      ! if (mp_dev_mode) then
-      !   write(*,FMT='(72("#"))')
-      !   write(*,*) "Sending ", num_trans, "particles (from/to)", src_proc, dest_proc
-      !   write(*,*) "numpart before: ", numpart
-      ! end if
+      if (mp_dev_mode) then
+        write(*,FMT='(72("#"))')
+        write(*,*) "Sending ", num_trans, "particles (from/to)", src_proc, dest_proc
+        write(*,*) "numpart before: ", numpart
+      end if
 
       call MPI_SEND(nclass(ll:ul),num_trans,&
@@ -717 +742 @@
       numpart = numpart-num_trans
 
-      ! if (mp_dev_mode) then
-      !   write(*,*) "numpart after: ", numpart
-      !   write(*,FMT='(72("#"))')
-      ! end if
+      if (mp_dev_mode) then
+        write(*,*) "numpart after: ", numpart
+        write(*,FMT='(72("#"))')
+      end if
 
     else if (mp_partid.eq.dest_proc) then
@@ -731 +756 @@
       ul=numpart+num_trans
 
-      ! if (mp_dev_mode) then
-      !   write(*,FMT='(72("#"))')
-      !   write(*,*) "Receiving ", num_trans, "particles (from/to)", src_proc, dest_proc
-      !   write(*,*) "numpart before: ", numpart
-      ! end if
+      if (mp_dev_mode) then
+        write(*,FMT='(72("#"))')
+        write(*,*) "Receiving ", num_trans, "particles (from/to)", src_proc, dest_proc
+        write(*,*) "numpart before: ", numpart
+      end if
 
 ! We could receive the data directly at nclass(ll:ul) etc., but this leaves
@@ -785 +810 @@
       do i=1, num_trans
 ! Take into acount that we may have transferred invalid particles
-        if (itra1_tmp(minpart).ne.itime) goto 200
+        if (itra1_tmp(i).ne.itime) cycle
         do ipart=minpart,maxnumpart
           if (itra1(ipart).ne.itime) then
-            itra1(ipart) = itra1_tmp(minpart)
-            npoint(ipart) = npoint_tmp(minpart)
-            nclass(ipart) = nclass_tmp(minpart)
-            idt(ipart) = idt_tmp(minpart)
-            itramem(ipart) = itramem_tmp(minpart)
-            itrasplit(ipart) = itrasplit_tmp(minpart)
-            xtra1(ipart) = xtra1_tmp(minpart)
-            ytra1(ipart) = ytra1_tmp(minpart)
-            ztra1(ipart) = ztra1_tmp(minpart)
-            xmass1(ipart,:) = xmass1_tmp(minpart,:)
-! Increase numpart, if necessary
-            numpart=max(numpart,ipart)
+            itra1(ipart) = itra1_tmp(i)
+            npoint(ipart) = npoint_tmp(i)
+            nclass(ipart) = nclass_tmp(i)
+            idt(ipart) = idt_tmp(i)
+            itramem(ipart) = itramem_tmp(i)
+            itrasplit(ipart) = itrasplit_tmp(i)
+            xtra1(ipart) = xtra1_tmp(i)
+            ytra1(ipart) = ytra1_tmp(i)
+            ztra1(ipart) = ztra1_tmp(i)
+            xmass1(ipart,:) = xmass1_tmp(i,:)
             goto 200 ! Storage space has been found, stop searching
           end if
+! :TODO: add check for if too many particles requiried
         end do
-200     minpart=minpart+1
+200     minpart=ipart+1
       end do
+! Increase numpart, if necessary
+      numpart=max(numpart,ipart)
 
       deallocate(itra1_tmp,npoint_tmp,nclass_tmp,idt_tmp,itramem_tmp,itrasplit_tmp,&
            & xtra1_tmp,ytra1_tmp,ztra1_tmp,xmass1_tmp)
 
-      ! if (mp_dev_mode) then
-      !   write(*,*) "numpart after: ", numpart
-      !   write(*,FMT='(72("#"))')
-      ! end if
+      if (mp_dev_mode) then
+        write(*,*) "numpart after: ", numpart
+        write(*,FMT='(72("#"))')
+      end if
 
     else
@@ -2727 +2753 @@
 ! write(*,FMT='(A60,TR1,F9.2)') 'TOTAL CPU TIME FOR VERTTRANSFORM:',&
 !      & mp_vt_time_total
-! NB: the 'flush' function is possibly a gfortran-specific extension
-          call flush()
+! NB: the 'flush' function is possibly a gfortran-specific extension,
+! comment out if it gives problems
+!          call flush()
         end if
       end do