Index: palm/trunk/SOURCE/pmc_child_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_child_mod.f90	(revision 3961)
+++ palm/trunk/SOURCE/pmc_child_mod.f90	(revision 3962)
@@ -22,8 +22,11 @@
 ! ------------------
 ! 
-!
+! 
 ! Former revisions:
 ! -----------------
 ! $Id$
+! Bugfixes in initial settings of child and parent communication patterns. 
+!
+! 3945 2019-05-02 11:29:27Z raasch
 !
 ! 3932 2019-04-24 17:31:34Z suehring
@@ -583,12 +586,14 @@
 !--                                    recv -> parent to child transfer
 !--                                    send -> child to parent transfer
-    INTEGER(iwp) ::  arlen    !<
-    INTEGER(iwp) ::  myindex  !<
-    INTEGER(iwp) ::  i        !<
-    INTEGER(iwp) ::  ierr     !<
-    INTEGER(iwp) ::  istat    !<
-    INTEGER(iwp) ::  j        !<
-    INTEGER(iwp) ::  rcount   !<
-    INTEGER(iwp) ::  tag      !<
+    INTEGER(iwp) ::  arlen        !<
+    INTEGER(iwp) ::  myindex      !<
+    INTEGER(iwp) ::  i            !<
+    INTEGER(iwp) ::  ierr         !<
+    INTEGER(iwp) ::  istat        !<
+    INTEGER(iwp) ::  j            !<
+    INTEGER(iwp) ::  lo_nr_arrays !<
+    INTEGER(iwp) ::  rcount       !<
+    INTEGER(iwp) ::  tag          !<
+    INTEGER(iwp) ::  total_npes   !<
 
     INTEGER(iwp), PARAMETER ::  noindex = -1  !<
@@ -596,4 +601,7 @@
     INTEGER(idp)                   ::  bufsize  !< size of MPI data window
     INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
+    
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  myindex_s
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  myindex_r
 
     INTEGER(iwp),DIMENSION(1024) ::  req  !<
@@ -606,4 +614,19 @@
     Type(C_PTR)             ::  base_ptr  !<
 
+  
+    CALL MPI_COMM_SIZE (me%intra_comm, total_npes, ierr)
+
+    lo_nr_arrays = me%pes(1)%nr_arrays
+
+    ALLOCATE(myindex_s(lo_nr_arrays,0:total_npes-1))
+    ALLOCATE(myindex_r(lo_nr_arrays,0:total_npes-1))
+
+    myindex_s = 0
+
+!
+!-- Receive indices from child
+    CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER,                   &
+                       myindex_r, lo_nr_arrays, MPI_INTEGER,                   &
+                       me%intra_comm, ierr )
 
     myindex = 0
@@ -614,13 +637,7 @@
     DO  i = 1, me%inter_npes
        ape => me%pes(i)
-       tag = 200
        DO  j = 1, ape%nr_arrays
           ar => ape%array_list(j)
-!
-!--       Receive index from child
-          tag = tag + 1
-          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,     &
-                         MPI_STATUS_IGNORE, ierr )
-          ar%recvindex = myindex
+          ar%recvindex = myindex_r(j,i-1)
 !
 !--       Determine max, because child buffer is allocated only once
@@ -637,4 +654,5 @@
        ENDDO
     ENDDO
+
 !
 !-- Create RMA (one sided communication) data buffer.
@@ -657,4 +675,7 @@
     rcount  = 0
     bufsize = 8
+
+    myindex_s = 0
+    myindex_r = 0
 
     DO  i = 1, me%inter_npes
@@ -668,25 +689,12 @@
              arlen = ape%nrele*ar%a_dim(1)
           ENDIF
-          tag    = tag + 1
-          rcount = rcount + 1
+
           IF ( ape%nrele > 0 )  THEN
-             CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, &
-                             req(rcount), ierr )
              ar%sendindex = myindex
           ELSE
-             CALL MPI_ISEND( noindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, &
-                             req(rcount), ierr )
              ar%sendindex = noindex
           ENDIF
-!
-!--       Maximum of 1024 pending requests
-!         1024 is an arbitrary value just to make sure the number of pending 
-!         requests is getting too large. It is possible that this value has to 
-!         be adjusted in case of running the model on large number of cores. 
-
-          IF ( rcount == 1024 )  THEN
-             CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
-             rcount = 0
-          ENDIF
+
+          myindex_s(j,i-1) = ar%sendindex
 
           IF ( ape%nrele > 0 )  THEN
@@ -698,9 +706,15 @@
        ENDDO
 
-       IF ( rcount > 0 )  THEN
-          CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
-       ENDIF
-
-    ENDDO
+    ENDDO
+!
+!-- Send indices to parent
+
+    CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER,                   &
+                       myindex_r, lo_nr_arrays, MPI_INTEGER,                   &
+                       me%intra_comm, ierr)
+
+    DEALLOCATE( myindex_s )
+    DEALLOCATE( myindex_r )
+
 !
 !-- Create RMA (one sided communication) window for data buffer child to parent
Index: palm/trunk/SOURCE/pmc_parent_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_parent_mod.f90	(revision 3961)
+++ palm/trunk/SOURCE/pmc_parent_mod.f90	(revision 3962)
@@ -26,4 +26,7 @@
 ! -----------------
 ! $Id$
+! Bugfixes in initial settings of child and parent communication patterns. 
+! 
+! 3655 2019-01-07 16:51:22Z knoop
 ! explicit kind settings
 ! 
@@ -473,16 +476,17 @@
     INTEGER(iwp), INTENT(IN) ::  childid   !<
 
-    INTEGER(iwp)                   ::  arlen    !<
-    INTEGER(iwp)                   ::  i        !<
-    INTEGER(iwp)                   ::  ierr     !<
-    INTEGER(iwp)                   ::  j        !<
-    INTEGER(iwp)                   ::  myindex  !<
-    INTEGER(iwp)                   ::  rcount   !< count MPI requests
-    INTEGER(iwp)                   ::  tag      !<
+    INTEGER(iwp)                   ::  arlen       !<
+    INTEGER(iwp)                   ::  i           !<
+    INTEGER(iwp)                   ::  ierr        !<
+    INTEGER(iwp)                   ::  j           !<
+    INTEGER(iwp)                   ::  lo_nr_arrays !< store number of arrays in  local variiab le
+    INTEGER(iwp)                   ::  myindex     !<
+    INTEGER(iwp)                   ::  total_npes  !< Total Number of PEs Parent and Child
 
     INTEGER(idp)                   ::  bufsize  !< size of MPI data window
     INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
-
-    INTEGER(iwp), DIMENSION(1024)       ::  req      !<
+    
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  myindex_s
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  myindex_r
 
     TYPE(C_PTR)             ::  base_ptr  !<
@@ -493,9 +497,19 @@
     REAL(wp),DIMENSION(:), POINTER, SAVE ::  base_array_cp  !< base array for child to parent transfer
 
+    call MPI_COMM_SIZE (children(childid)%intra_comm, total_npes, ierr)
 !
 !-- Parent to child direction
     myindex = 1
-    rcount  = 0
     bufsize = 8
+!
+!-- All Child processes get the same number of arrays
+!-- Therfore the number of arrays form the first Child process can be used for Dimension.
+    lo_nr_arrays = children(childid)%pes(1)%nr_arrays
+
+    ALLOCATE( myindex_s(lo_nr_arrays,0:total_npes-1) )
+    ALLOCATE( myindex_r(lo_nr_arrays,0:total_npes-1) )
+
+    myindex_s = 0
+
 !
 !-- First stride: compute size and set index
@@ -503,5 +517,4 @@
 
        ape => children(childid)%pes(i)
-       tag = 200
 
        DO  j = 1, ape%nr_arrays
@@ -516,16 +529,8 @@
           ENDIF
           ar%sendindex = myindex
-
-          tag    = tag + 1
-          rcount = rcount + 1
-          CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag,                   &
-                          children(childid)%inter_comm, req(rcount), ierr )
-!
-!--       Maximum of 1024 pending requests
-
-          IF ( rcount == 1024 )  THEN
-             CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
-             rcount = 0
-          ENDIF
+!
+!         Using intra communicator for MPU_Alltoall, the numbers of the child processes are after the paremt ones
+
+          myindex_s(j,i-1+children(childid)%model_npes) = myindex
 
           myindex = myindex + arlen
@@ -534,9 +539,21 @@
        ENDDO
 
-       IF ( rcount > 0 )  THEN
-          CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
-       ENDIF
-
-    ENDDO
+    ENDDO
+!
+!-- Using MPI_Alltoall to send indices from  Parent to Child
+!-- The data comming back from the child processes are ignored.
+
+    CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER,                   &
+                       myindex_r, lo_nr_arrays, MPI_INTEGER,                   &
+                       children(childid)%intra_comm, ierr )
+
+!
+!-- Using MPI_Alltoall to receive indices from Child
+    myindex_s = 0
+    myindex_r = 0
+
+    CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER,                   &
+                       myindex_r, lo_nr_arrays, MPI_INTEGER,                   &
+                       children(childid)%intra_comm, ierr )
 !
 !-- Create RMA (One Sided Communication) window for data buffer parent to
@@ -585,12 +602,8 @@
     DO  i = 1, children(childid)%inter_npes
        ape => children(childid)%pes(i)
-       tag = 300
        DO  j = 1, ape%nr_arrays
           ar => ape%array_list(j)
 !
 !--       Receive index from child
-          tag = tag + 1
-          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag,                    &
-                         children(childid)%inter_comm, MPI_STATUS_IGNORE, ierr )
           IF ( ar%nrdims == 3 )  THEN
              bufsize = MAX( bufsize,                                           &
@@ -599,7 +612,11 @@
              bufsize = MAX( bufsize, INT( ape%nrele, MPI_ADDRESS_KIND ) )
           ENDIF
-          ar%recvindex = myindex
+          ar%recvindex = myindex_r(j,i-1+children(childid)%model_npes)
         ENDDO
     ENDDO
+
+    DEALLOCATE( myindex_s )
+    DEALLOCATE( myindex_r )
+
 !
 !-- Create RMA (one sided communication, RMA = Remote Memory Access) data buffer.
