[Dart-dev] DART/branches Revision: 12601

[dart at ucar.edu]

nancy at ucar.edu
2018-05-24 14:01:24 -0600 (Thu, 24 May 2018)
252
fold in the changes i made on another branch to allow the
calling code to pass in an already created communicator
which we'll use for our MPI calls.

this was copied from the xcesm classic-based branch into 
the cesm_dart_esp manhattan-based branch.





Modified: DART/branches/cesm_dart_esp/assimilation_code/modules/utilities/mpi_utilities_mod.f90
===================================================================
--- DART/branches/cesm_dart_esp/assimilation_code/modules/utilities/mpi_utilities_mod.f90	2018-05-24 19:16:16 UTC (rev 12600)
+++ DART/branches/cesm_dart_esp/assimilation_code/modules/utilities/mpi_utilities_mod.f90	2018-05-24 20:01:24 UTC (rev 12601)
@@ -73,6 +73,7 @@
 ! block below.  Please leave the BLOCK comment lines unchanged.
 
 ! !!SYSTEM_BLOCK_EDIT START COMMENTED_OUT
+! !#if .not. defined (__GFORTRAN__) .and. .not. defined(__NAG__)
 ! ! interface block for getting return code back from system() routine
 ! interface
 !  function system(string)
@@ -81,6 +82,7 @@
 !  end function system
 ! end interface
 ! ! end block
+! !#endif
 ! !!SYSTEM_BLOCK_EDIT END COMMENTED_OUT
 
 
@@ -118,11 +120,13 @@
 
 logical :: module_initialized   = .false.
 
-character(len = 129) :: saved_progname = ''
-character(len = 129) :: shell_name = ''   ! if needed, add ksh, tcsh, bash, etc
+character(len = 256) :: saved_progname = ''
+character(len = 256) :: shell_name = ''   ! if needed, add ksh, tcsh, bash, etc
 integer :: head_task = 0         ! def 0, but N-1 if reverse_task_layout true
 logical :: print4status = .true. ! minimal messages for async4 handshake
 
+logical :: given_communicator = .false.   ! if communicator passed in, use it
+
 character(len = 256) :: errstring, errstring1
 
 ! for broadcasts, pack small messages into larger ones.  remember that the
@@ -180,17 +184,18 @@
 ! mpi cover routines
 !-----------------------------------------------------------------------------
 
-subroutine initialize_mpi_utilities(progname, alternatename)
- character(len=*), intent(in), optional :: progname
- character(len=*), intent(in), optional :: alternatename
+!> Initialize MPI and query it for global information.  Make a duplicate
+!> communicator so that any user code which wants to call MPI will not 
+!> interfere with any outstanding asynchronous requests, accidental tag
+!> matches, etc.  This routine must be called before any other routine in
+!> this file, and it should not be called more than once (but it does have
+!> defensive code in case that happens.)
 
+subroutine initialize_mpi_utilities(progname, alternatename, communicator)
 
-! Initialize MPI and query it for global information.  Make a duplicate
-! communicator so that any user code which wants to call MPI will not 
-! interfere with any outstanding asynchronous requests, accidental tag
-! matches, etc.  This routine must be called before any other routine in
-! this file, and it should not be called more than once (but it does have
-! defensive code in case that happens.)
+character(len=*), intent(in), optional :: progname
+character(len=*), intent(in), optional :: alternatename
+integer,          intent(in), optional :: communicator
 
 integer :: errcode, iunit
 logical :: already
@@ -220,17 +225,22 @@
    endif
 endif
 
-call MPI_Comm_rank(MPI_COMM_WORLD, myrank, errcode)
+if (.not. present(communicator)) then
+! give this a temporary initial value, in case we call the abort code.
+! later down, we will dup the world comm and use a private comm for
+! our communication.
+my_local_comm = MPI_COMM_WORLD
+else
+   my_local_comm = communicator
+   given_communicator = .true.
+endif
+
+call MPI_Comm_rank(my_local_comm, myrank, errcode)
 if (errcode /= MPI_SUCCESS) then
    write(*, *) 'MPI_Comm_rank returned error code ', errcode
    call exit(-99)
 endif
 
-! give this a temporary initial value, in case we call the abort code.
-! later down, we will dup the world comm and use a private comm for
-! our communication.
-my_local_comm = MPI_COMM_WORLD
-
 ! pass the arguments through so the utilities can log the program name
 ! only PE0 gets to output, whenever possible.
 if (myrank == 0) then
@@ -275,7 +285,7 @@
 ! duplicate the world communicator to isolate us from any other user
 ! calls to MPI.  All subsequent mpi calls here will use the local communicator
 ! and not the global world comm.
-if (create_local_comm) then
+if (.not. given_communicator .and. create_local_comm) then
    call MPI_Comm_dup(MPI_COMM_WORLD, my_local_comm, errcode)
    if (errcode /= MPI_SUCCESS) then