Changeset 6a678e3 in flexpart.git for src/mpi_mod.f90

Timestamp:

Jan 25, 2016, 2:17:34 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:

26f6039

Parents:

fddc6ec

Message:

Added option to use double precision for calculating the deposition fields

File:

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

src/mpi_mod.f90

@@ -53 +53 @@
 !                         unless a dedicated process runs getfields/readwind *
 ! lmp_sync                If .false., use asynchronous MPI                   *
+! mp_cp                   Real precision to use for deposition fields        *
 !                                                                            *
 !                                                                            *
@@ -84 +85 @@
   integer :: mp_seed=0
   integer, parameter :: mp_sp=MPI_REAL4, mp_dp=MPI_REAL8
-  integer, parameter :: mp_pp=mp_sp
+  integer :: mp_cp
   integer, parameter :: id_root=0 ! master process
 
@@ -163 +164 @@
 !   mp_np       number of running processes, decided at run-time
 !***********************************************************************
-    use par_mod, only: maxpart, numwfmem
+    use par_mod, only: maxpart, numwfmem, dep_prec
     use com_mod, only: mpi_mode
 
@@ -170 +171 @@
     integer :: i,j,s,addmaxpart=0
 
-! each process gets an ID (mp_pid) in the range 0,..,mp_np-1
+! Each process gets an ID (mp_pid) in the range 0,..,mp_np-1
     call MPI_INIT(mp_ierr)
     if (mp_ierr /= 0) goto 100
@@ -179 +180 @@
 
 
-! this variable is used to handle subroutines common to parallel/serial version
+! Variable mpi_mode is used to handle subroutines common to parallel/serial version
     if (lmp_sync) then
       mpi_mode=2 ! hold 2 windfields in memory
@@ -188 +189 @@
     if (mp_pid.ne.0) then
       lroot = .false.
+    end if
+
+! Set MPI precision to use for transferring deposition fields
+!************************************************************
+    if (dep_prec==dp) then
+      mp_cp = MPI_REAL8
+      if (lroot) write(*,*) 'Using double precision for deposition fields'
+    else if (dep_prec==sp) then
+      mp_cp = MPI_REAL4
+      if (lroot) write(*,*) 'Using single precision for deposition fields'
+    else
+      write(*,*) 'ERROR: something went wrong setting MPI real precision'
+      stop
     end if
 
@@ -1671 +1685 @@
 
     if ((WETDEP).and.(ldirect.gt.0)) then
-      call MPI_Reduce(wetgridunc, wetgridunc0, grid_size2d, mp_sp, MPI_SUM, id_root, &
+      call MPI_Reduce(wetgridunc, wetgridunc0, grid_size2d, mp_cp, MPI_SUM, id_root, &
            & mp_comm_used, mp_ierr)
       if (mp_ierr /= 0) goto 600
@@ -1677 +1691 @@
 
     if ((DRYDEP).and.(ldirect.gt.0)) then
-      call MPI_Reduce(drygridunc, drygridunc0, grid_size2d, mp_sp, MPI_SUM, id_root, &
+      call MPI_Reduce(drygridunc, drygridunc0, grid_size2d, mp_cp, MPI_SUM, id_root, &
            & mp_comm_used, mp_ierr)
       if (mp_ierr /= 0) goto 600
@@ -1747 +1761 @@
 
     if ((WETDEP).and.(ldirect.gt.0)) then
-      call MPI_Reduce(wetgriduncn, wetgriduncn0, grid_size2d, mp_sp, MPI_SUM, id_root, &
+      call MPI_Reduce(wetgriduncn, wetgriduncn0, grid_size2d, mp_cp, MPI_SUM, id_root, &
            & mp_comm_used, mp_ierr)
       if (mp_ierr /= 0) goto 600
@@ -1753 +1767 @@
 
     if ((DRYDEP).and.(ldirect.gt.0)) then
-      call MPI_Reduce(drygriduncn, drygriduncn0, grid_size2d, mp_sp, MPI_SUM, id_root, &
+      call MPI_Reduce(drygriduncn, drygriduncn0, grid_size2d, mp_cp, MPI_SUM, id_root, &
            & mp_comm_used, mp_ierr)
       if (mp_ierr /= 0) goto 600