Changeset d6a0977 in flexpart.git for src/mpi_mod.f90

Timestamp:

Dec 14, 2015, 3:10:04 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:

f75967d

Parents:

88d8c3d

Message:

Updates to Henrik's wet depo scheme

File:

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

src/mpi_mod.f90

@@ -89 +89 @@
 ! MPI tags/requests for send/receive operation
   integer :: tm1
-  integer, parameter :: nvar_async=27 !29 :DBG:
+  integer, parameter :: nvar_async=26 !27 !29 :DBG:
 !integer, dimension(:), allocatable :: tags
   integer, dimension(:), allocatable :: reqs
@@ -119 +119 @@
   logical, parameter :: mp_dbg_out = .false.
   logical, parameter :: mp_time_barrier=.true.
-  logical, parameter :: mp_measure_time=.true.
+  logical, parameter :: mp_measure_time=.false.
   logical, parameter :: mp_exact_numpart=.true.
 
@@ -207 +207 @@
       write(*,FMT='(80("#"))')
 ! Force "syncronized" version if all processes will call getfields
-    else if (.not.lmp_sync.and.mp_np.lt.read_grp_min) then
+    else if ((.not.lmp_sync.and.mp_np.lt.read_grp_min).or.(mp_np.eq.1)) then
       if (lroot) then
         write(*,FMT='(80("#"))')
@@ -963 +963 @@
 ! cloud water/ice:
     if (readclouds) then
-      call MPI_Bcast(clwc(:,:,:,li:ui),d3s1,mp_pp,id_read,MPI_COMM_WORLD,mp_ierr)
-      if (mp_ierr /= 0) goto 600
-      call MPI_Bcast(ciwc(:,:,:,li:ui),d3s1,mp_pp,id_read,MPI_COMM_WORLD,mp_ierr)
-      if (mp_ierr /= 0) goto 600
+      call MPI_Bcast(icloud_stats(:,:,:,li:ui),d2_size1*5,mp_pp,id_read,MPI_COMM_WORLD,mp_ierr)
+      if (mp_ierr /= 0) goto 600
+
+      ! call MPI_Bcast(clwc(:,:,:,li:ui),d3s1,mp_pp,id_read,MPI_COMM_WORLD,mp_ierr)
+      ! if (mp_ierr /= 0) goto 600
+      ! call MPI_Bcast(ciwc(:,:,:,li:ui),d3s1,mp_pp,id_read,MPI_COMM_WORLD,mp_ierr)
+      ! if (mp_ierr /= 0) goto 600
     end if
 
@@ -1189 +1192 @@
 !
 ! TODO
-!   Transfer cloud water/ice
 !
 !*******************************************************************************
@@ -1334 +1336 @@
       if (readclouds) then
         i=i+1
-        call MPI_Isend(clwc(:,:,:,mind),d3s1,mp_pp,dest,tm1,&
+        call MPI_Isend(icloud_stats(:,:,:,mind),d2s1*5,mp_pp,dest,tm1,&
              &MPI_COMM_WORLD,reqs(i),mp_ierr)
         if (mp_ierr /= 0) goto 600
-        i=i+1
-
-        call MPI_Isend(ciwc(:,:,:,mind),d3s1,mp_pp,dest,tm1,&
-             &MPI_COMM_WORLD,reqs(i),mp_ierr)
-        if (mp_ierr /= 0) goto 600
-! else
-!   i=i+2
+
+        ! call MPI_Isend(clwc(:,:,:,mind),d3s1,mp_pp,dest,tm1,&
+        !      &MPI_COMM_WORLD,reqs(i),mp_ierr)
+        ! if (mp_ierr /= 0) goto 600
+        ! i=i+1
+
+        ! call MPI_Isend(ciwc(:,:,:,mind),d3s1,mp_pp,dest,tm1,&
+        !      &MPI_COMM_WORLD,reqs(i),mp_ierr)
+        ! if (mp_ierr /= 0) goto 600
+
       end if
-
     end do
 
@@ -1371 +1375 @@
 !
 ! TODO
-!   Transfer cloud water/ice
 !
 !*******************************************************************************
@@ -1390 +1393 @@
 !    integer :: d3s1,d3s2,d2s1,d2s2
 !*******************************************************************************
-
-! :TODO: don't need these
-! d3s1=d3_size1
-! d3s2=d3_size2
-! d2s1=d2_size1 
-! d2s2=d2_size2
 
 ! At the time this immediate receive is posted, memstat is the state of
@@ -1545 +1542 @@
     if (readclouds) then
       j=j+1
-      call MPI_Irecv(clwc(:,:,:,mind),d3s1,mp_pp,id_read,MPI_ANY_TAG,&
-           &MPI_COMM_WORLD,reqs(j),mp_ierr)    
-      if (mp_ierr /= 0) goto 600 
-      j=j+1
-      call MPI_Irecv(ciwc(:,:,:,mind),d3s1,mp_pp,id_read,MPI_ANY_TAG,&
-           &MPI_COMM_WORLD,reqs(j),mp_ierr)    
-      if (mp_ierr /= 0) goto 600 
+
+      call MPI_Irecv(icloud_stats(:,:,:,mind),d2s1*5,mp_pp,id_read,MPI_ANY_TAG,&
+           &MPI_COMM_WORLD,reqs(j),mp_ierr)
+      if (mp_ierr /= 0) goto 600
+
+      ! call MPI_Irecv(clwc(:,:,:,mind),d3s1,mp_pp,id_read,MPI_ANY_TAG,&
+      !      &MPI_COMM_WORLD,reqs(j),mp_ierr)    
+      ! if (mp_ierr /= 0) goto 600 
+      ! j=j+1
+      ! call MPI_Irecv(ciwc(:,:,:,mind),d3s1,mp_pp,id_read,MPI_ANY_TAG,&
+      !      &MPI_COMM_WORLD,reqs(j),mp_ierr)    
+      ! if (mp_ierr /= 0) goto 600 
+
     end if
 
@@ -2089 +2092 @@
     implicit none
 
-    integer, parameter :: li=1, ui=3 ! wfmem indices (i.e, operate on entire field)
+    integer :: li=1, ui=2 ! wfmem indices (i.e, operate on entire field)
+
+    if (.not.lmp_sync) ui=3