Index: palm/trunk/SOURCE/pmc_handle_communicator_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_handle_communicator_mod.f90	(revision 2516)
+++ palm/trunk/SOURCE/pmc_handle_communicator_mod.f90	(revision 2599)
@@ -26,4 +26,8 @@
 ! -----------------
 ! $Id$
+! Separate peer communicator peer_comm introduced for MPI_INTERCOMM_CREATE.
+! Some cleanup and commenting improvements. 
+! 
+! 2516 2017-10-04 11:03:04Z suehring
 ! Remove tabs
 ! 
@@ -127,5 +131,5 @@
     PUBLIC  pmc_status_ok, pmc_status_error
 
-    INTEGER, PARAMETER, PUBLIC ::  pmc_error_npes        = 1  !< illegal number of PEs
+    INTEGER, PARAMETER, PUBLIC ::  pmc_error_npes        = 1  !< illegal number of processes
     INTEGER, PARAMETER, PUBLIC ::  pmc_namelist_error    = 2  !< error(s) in nestpar namelist
     INTEGER, PARAMETER, PUBLIC ::  pmc_no_namelist_found = 3  !< no couple layout namelist found
@@ -144,5 +148,6 @@
     INTEGER, PUBLIC ::  m_model_rank          !<
     INTEGER, PUBLIC ::  m_model_npes          !<
-    INTEGER         ::  m_parent_remote_size  !< number of parent PEs
+    INTEGER         ::  m_parent_remote_size  !< number of processes in the parent model 
+    INTEGER         ::  peer_comm             !< peer_communicator for inter communicators
 
     INTEGER, DIMENSION(pmc_max_models), PUBLIC ::  m_to_child_comm    !< communicator to the child(ren)
@@ -200,5 +205,5 @@
     CALL MPI_COMM_SIZE( MPI_COMM_WORLD, m_world_npes, istat )
 !
-!-- Only PE 0 of root model reads
+!-- Only process 0 of root model reads
     IF ( m_world_rank == 0 )  THEN
 
@@ -210,5 +215,5 @@
        THEN
 !
-!--       Calculate start PE of every model
+!--       Determine the first process id of each model
           start_pe(1) = 0
           DO  i = 2, m_ncpl+1
@@ -217,6 +222,6 @@
 
 !
-!--       The number of cores provided with the run must be the same as the
-!--       total sum of cores required by all nest domains
+!--       The sum of numbers of processes requested by all the domains
+!--       must be equal to the total number of processes of the run
           IF ( start_pe(m_ncpl+1) /= m_world_npes )  THEN
              WRITE ( message_string, '(2A,I6,2A,I6,A)' )                        &
@@ -231,7 +236,8 @@
     ENDIF
 !
-!-- Broadcast the read status. This synchronises all other PEs with PE 0 of
-!-- the root model. Without synchronisation, they would not behave in the
-!-- correct way (e.g. they would not return in case of a missing NAMELIST)
+!-- Broadcast the read status. This synchronises all other processes with 
+!-- process 0 of the root model. Without synchronisation, they would not 
+!-- behave in the correct way (e.g. they would not return in case of a
+!-- missing NAMELIST).
     CALL MPI_BCAST( pmc_status, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
 
@@ -254,7 +260,6 @@
     ENDIF
 
-    CALL MPI_BCAST( m_ncpl,          1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
-    CALL MPI_BCAST( start_pe, m_ncpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
-
+    CALL MPI_BCAST( m_ncpl,          1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
+    CALL MPI_BCAST( start_pe, m_ncpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
 !
 !-- Broadcast coupling layout
@@ -277,5 +282,4 @@
     CALL MPI_BCAST( nesting_datatransfer_mode, LEN(nesting_datatransfer_mode),  &
                     MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
-
 !
 !-- Assign global MPI processes to individual models by setting the couple id
@@ -288,5 +292,4 @@
     ENDDO
     m_my_cpl_rank = m_world_rank - start_pe(i)
-
 !
 !-- MPI_COMM_WORLD is the communicator for ALL models (MPI-1 approach).
@@ -296,10 +299,9 @@
                          istat )
 !
-!-- Get size and rank of the model running on this PE
+!-- Get size and rank of the model running on this process
     CALL  MPI_COMM_RANK( comm, m_model_rank, istat )
     CALL  MPI_COMM_SIZE( comm, m_model_npes, istat )
-
-!
-!-- Broadcast (from PE 0) the parent id and id of every model
+!
+!-- Broadcast (from process 0) the parent id and id of every model
     DO  i = 1, m_ncpl
        CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0,              &
@@ -308,5 +310,4 @@
                        MPI_COMM_WORLD, istat )
     ENDDO
-
 !
 !-- Save the current model communicator for pmc internal use
@@ -314,39 +315,36 @@
 
 !
-!-- Create intercommunicator between parent and children.
+!-- Create intercommunicator between the parent and children.
 !-- MPI_INTERCOMM_CREATE creates an intercommunicator between 2 groups of
 !-- different colors.
-!-- The grouping was done above with MPI_COMM_SPLIT
+!-- The grouping was done above with MPI_COMM_SPLIT.
+!-- A duplicate of MPI_COMM_WORLD is created and used as peer communicator 
+!-- (peer_comm) for MPI_INTERCOMM_CREATE.
+    CALL MPI_COMM_DUP( MPI_COMM_WORLD, peer_comm, ierr ) 
     DO  i = 2, m_ncpl
-
        IF ( m_couplers(i)%parent_id == m_my_cpl_id )  THEN
 !
-!--       Collect parent PEs.
-!--       Every model exept the root model has a parent model which acts as
-!--       parent model. Create an intercommunicator to connect current PE to
-!--       all children PEs
+!--       Identify all children models of the current model and create 
+!--       inter-communicators to connect between the current model and its 
+!--       children models.
           tag = 500 + i
-          CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD, start_pe(i),      &
+          CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm, start_pe(i),           &
                                      tag, m_to_child_comm(i), istat)
           childcount = childcount + 1
           activeparent(i) = 1
-
        ELSEIF ( i == m_my_cpl_id)  THEN
 !
-!--       Collect children PEs.
-!--       Every model except the root model has a parent model. 
-!--       Create an intercommunicator to connect current PE to all parent PEs
+!--       Create an inter-communicator to connect between the current 
+!--       model and its parent model.    
           tag = 500 + i
-          CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD,                   &
+          CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm,                        &
                                      start_pe(m_couplers(i)%parent_id),         &
                                      tag, m_to_parent_comm, istat )
        ENDIF
-
     ENDDO
-
-!
-!-- If I am parent, count the number of children that I have
+!
+!-- If I am a parent, count the number of children I have.
 !-- Although this loop is symmetric on all processes, the "activeparent" flag
-!-- is true (==1) on the respective individual PE only.
+!-- is true (==1) on the respective individual process only.
     ALLOCATE( pmc_parent_for_child(childcount+1) )
 
@@ -362,5 +360,5 @@
     IF ( m_my_cpl_id > 1 )  THEN
        CALL MPI_COMM_REMOTE_SIZE( m_to_parent_comm, m_parent_remote_size,       &
-                                  istat)
+                                  istat )
     ELSE
 !
@@ -369,10 +367,10 @@
     ENDIF
 !
-!-- Set myid to non-tero value except for the root domain. This is a setting
+!-- Set myid to non-zero value except for the root domain. This is a setting
 !-- for the message routine which is called at the end of pmci_init. That
 !-- routine outputs messages for myid = 0, only. However, myid has not been
-!-- assigened so far, so that all PEs of the root model would output a
-!-- message. To avoid this, set myid to some other value except for PE0 of the
-!-- root domain.
+!-- assigened so far, so that all processes of the root model would output a
+!-- message. To avoid this, set myid to some other value except for process 0 
+!-- of the root domain.
     IF ( m_world_rank /= 0 )  myid = 1
 
@@ -401,8 +399,8 @@
     INTEGER, INTENT(OUT), OPTIONAL ::  npe_total           !<
 
-    INTEGER ::  requested_cpl_id  !<
-
-    REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_x  !<
-    REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_y  !<
+    INTEGER ::  requested_cpl_id                           !<
+
+    REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_x       !<
+    REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_y       !<
 
 !
@@ -416,5 +414,4 @@
        requested_cpl_id = m_my_cpl_id
     ENDIF
-
 !
 !-- Return the requested information
@@ -459,5 +456,5 @@
 
  SUBROUTINE read_coupling_layout( nesting_datatransfer_mode, nesting_mode,      &
-                                  pmc_status )
+      pmc_status )
 
     IMPLICIT NONE
@@ -481,5 +478,4 @@
 
     pmc_status = pmc_status_ok
-
 !
 !-- Open the NAMELIST-file and read the nesting layout
@@ -487,33 +483,25 @@
     READ ( 11, nestpar, IOSTAT=istat )
 !
-!-- Set filepointer to the beginning of the file. Otherwise PE0 will later
+!-- Set filepointer to the beginning of the file. Otherwise process 0 will later
 !-- be unable to read the inipar-NAMELIST
     REWIND ( 11 )
 
     IF ( istat < 0 )  THEN
-
 !
 !--    No nestpar-NAMELIST found
        pmc_status = pmc_no_namelist_found
-
        RETURN
-
     ELSEIF ( istat > 0 )  THEN
-
 !
 !--    Errors in reading nestpar-NAMELIST
        pmc_status = pmc_namelist_error
        RETURN
-
-    ENDIF
-
+    ENDIF
 !
 !-- Output location message
     CALL location_message( 'initialize communicators for nesting', .FALSE. )
-
-!
-!-- Assign the layout to the internally used variable
+!
+!-- Assign the layout to the corresponding internally used variable m_couplers
     m_couplers = domain_layouts
-
 !
 !-- Get the number of nested models given in the nestpar-NAMELIST
@@ -521,5 +509,5 @@
 !
 !--    When id=-1 is found for the first time, the list of domains is finished
-        IF ( m_couplers(i)%id == -1  .OR.  i == pmc_max_models )  THEN
+       IF ( m_couplers(i)%id == -1  .OR.  i == pmc_max_models )  THEN
           IF ( m_couplers(i)%id == -1 )  THEN
              m_ncpl = i - 1
@@ -529,7 +517,5 @@
           ENDIF
        ENDIF
-
     ENDDO
-
 !
 !-- Make sure that all domains have equal lower left corner in case of vertical
