Index: palm/trunk/SOURCE/pmc_child_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_child_mod.f90	(revision 2101)
+++ palm/trunk/SOURCE/pmc_child_mod.f90	(revision 2599)
@@ -26,4 +26,7 @@
 ! -----------------
 ! $Id$
+! Some cleanup and commenting improvements only.
+! 
+! 2101 2017-01-05 16:42:31Z suehring
 !
 ! 2000 2016-08-20 18:09:15Z knoop
@@ -171,15 +174,13 @@
      CALL MPI_COMM_SIZE( me%model_comm, me%model_npes, istat )
      CALL MPI_COMM_REMOTE_SIZE( me%inter_comm, me%inter_npes, istat )
-
-!
-!--  Intra-communicater is used for MPI_GET
+!
+!--  Intra-communicator is used for MPI_GET
      CALL MPI_INTERCOMM_MERGE( me%inter_comm, .TRUE., me%intra_comm, istat )
      CALL MPI_COMM_RANK( me%intra_comm, me%intra_rank, istat )
 
      ALLOCATE( me%pes(me%inter_npes) )
-
-!
-!--  Allocate an array of type arraydef for all parent PEs to store information
-!--  of then transfer array
+!
+!--  Allocate an array of type arraydef for all parent processes to store 
+!--  information of then transfer array
      DO  i = 1, me%inter_npes
         ALLOCATE( me%pes(i)%array_list(pmc_max_array) )
@@ -201,5 +202,4 @@
 
     INTEGER, INTENT(OUT) ::  istat  !<
-
 !
 !-- Local variables
@@ -211,5 +211,4 @@
 
     istat = pmc_status_ok
-
 !
 !-- Check length of array names
@@ -229,5 +228,5 @@
 
 !
-!-- Broadcat to all child PEs
+!-- Broadcast to all child processes
 !-- TODO: describe what is broadcast here and why it is done
     CALL pmc_bcast( myname%couple_index, 0, comm=m_model_comm )
@@ -236,7 +235,6 @@
     CALL pmc_bcast( myname%childdesc,    0, comm=m_model_comm )
     CALL pmc_bcast( myname%nameonchild,  0, comm=m_model_comm )
-
-!
-!-- Broadcat to all parent PEs
+!
+!-- Broadcast to all parent processes
 !-- TODO: describe what is broadcast here and why it is done
     IF ( m_model_rank == 0 )  THEN
@@ -263,5 +261,4 @@
 
     LOGICAL, INTENT(IN), OPTIONAL ::  lastentry  !<
-
 !
 !-- Local variables
@@ -290,5 +287,5 @@
     INTEGER :: i, ierr, i2, j, nr  !<
     INTEGER :: indwin              !< MPI window object
-    INTEGER :: indwin2  !          < MPI window object
+    INTEGER :: indwin2             !< MPI window object
 
     INTEGER(KIND=MPI_ADDRESS_KIND) :: win_size !< Size of MPI window 1 (in bytes)
@@ -306,10 +303,8 @@
     CALL MPI_WIN_CREATE( dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm,    &
                          indwin, ierr )
-
 !
 !-- Open window on parent side
 !-- TODO: why is the next MPI routine called twice??
     CALL MPI_WIN_FENCE( 0, indwin, ierr )
-
 !
 !-- Close window on parent side and open on child side
@@ -321,10 +316,8 @@
                      MPI_INTEGER, indwin, ierr )
     ENDDO
-
 !
 !-- MPI_GET is non-blocking -> data in nrele is not available until MPI_FENCE is
 !-- called
     CALL MPI_WIN_FENCE( 0, indwin, ierr )
-
 !
 !-- Allocate memory for index array
@@ -344,12 +337,10 @@
     ALLOCATE( myind(2*winsize) )
     winsize = 1
-
 !
 !-- Local buffer used in MPI_GET can but must not be inside the MPI Window.
-!-- Here, we use a dummy for the MPI window because the parent PEs do not access
-!-- the RMA window via MPI_GET or MPI_PUT
+!-- Here, we use a dummy for the MPI window because the parent processes do 
+!-- not access the RMA window via MPI_GET or MPI_PUT
     CALL MPI_WIN_CREATE( dummy, winsize, iwp, MPI_INFO_NULL, me%intra_comm,     &
                          indwin2, ierr )
-
 !
 !-- MPI_GET is non-blocking -> data in nrele is not available until MPI_FENCE is
@@ -377,5 +368,4 @@
        ENDIF
     ENDDO
-
 !
 !-- Don't know why, but this barrier is necessary before we can free the windows
@@ -406,5 +396,4 @@
 !--  pmc_interface
      CHARACTER(LEN=*), INTENT(OUT) ::  myname  !<
-
 !
 !-- Local variables
@@ -414,9 +403,8 @@
 
     next_array_in_list = next_array_in_list + 1
-
-!
-!-- Array names are the same on all child PEs, so take first PE to get the name
+!
+!-- Array names are the same on all child PEs, so take first process to
+!-- get the name    
     ape => me%pes(1)
-
 !
 !-- Check if all arrays have been processed
@@ -429,5 +417,4 @@
 
     myname = ar%name
-
 !
 !-- Return true if legal array
@@ -545,17 +532,12 @@
     myindex = 0
     bufsize = 8
-
 !
 !-- Parent to child direction.
 !-- First stride: compute size and set index
     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
@@ -564,5 +546,4 @@
                          MPI_STATUS_IGNORE, ierr )
           ar%recvindex = myindex
-
 !
 !--       Determine max, because child buffer is allocated only once
@@ -573,9 +554,6 @@
              bufsize = MAX( bufsize, ar%a_dim(1)*ar%a_dim(2) )
           ENDIF
-
        ENDDO
-
-    ENDDO
-
+    ENDDO
 !
 !-- Create RMA (one sided communication) data buffer.
@@ -584,18 +562,13 @@
     CALL pmc_alloc_mem( base_array_pc, bufsize, base_ptr )
     me%totalbuffersize = bufsize*wp  ! total buffer size in byte
-
 !
 !-- Second stride: set buffer pointer
     DO  i = 1, me%inter_npes
-
        ape => me%pes(i)
-
        DO  j = 1, ape%nr_arrays
           ar => ape%array_list(j)
           ar%recvbuf = base_ptr
        ENDDO
-
-    ENDDO
-
+    ENDDO
 !
 !-- Child to parent direction
@@ -605,10 +578,7 @@
 
     DO  i = 1, me%inter_npes
-
        ape => me%pes(i)
        tag = 300
-
        DO  j = 1, ape%nr_arrays
-
           ar => ape%array_list(j)
           IF( ar%nrdims == 2 )  THEN
@@ -617,5 +587,4 @@
              arlen = ape%nrele*ar%a_dim(1)
           ENDIF
-
           tag    = tag + 1
           rcount = rcount + 1
@@ -629,8 +598,8 @@
              ar%sendindex = noindex
           ENDIF
-
 !
 !--       Maximum of 1024 outstanding requests
-!--       TODO: explain where this maximum comes from (arbitrary?)
+!--       TODO: explain where this maximum comes from (arbitrary?).
+!--       Outstanding = pending? 
           IF ( rcount == 1024 )  THEN
              CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
@@ -651,5 +620,4 @@
 
     ENDDO
-
 !
 !-- Create RMA (one sided communication) window for data buffer child to parent
@@ -670,18 +638,12 @@
     CALL MPI_WIN_FENCE( 0, me%win_parent_child, ierr )
     CALL MPI_BARRIER( me%intra_comm, ierr )
-
 !
 !-- Second stride: set buffer pointer
     DO  i = 1, me%inter_npes
-
        ape => me%pes(i)
-
        DO  j = 1, ape%nr_arrays
-
-          ar => ape%array_list(j)
-
+          ar => ape%array_list(j)          
           IF ( ape%nrele > 0 )  THEN
              ar%sendbuf = C_LOC( base_array_cp(ar%sendindex) )
-
 !
 !--          TODO: if this is an error to be really expected, replace the
@@ -695,7 +657,5 @@
              ENDIF
           ENDIF
-
        ENDDO
-
     ENDDO
 
@@ -743,5 +703,4 @@
        waittime = t2 - t1
     ENDIF
-
 !
 !-- Wait for buffer is filled.
@@ -753,11 +712,7 @@
 
     DO  ip = 1, me%inter_npes
-
        ape => me%pes(ip)
-
        DO  j = 1, ape%nr_arrays
-
           ar => ape%array_list(j)
-
           IF ( ar%nrdims == 2 )  THEN
              nr = ape%nrele
@@ -765,8 +720,6 @@
              nr = ape%nrele * ar%a_dim(1)
           ENDIF
-
           buf_shape(1) = nr
           CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
-
 !
 !--       MPI passive target RMA
@@ -780,19 +733,13 @@
              CALL MPI_WIN_UNLOCK( ip-1, me%win_parent_child, ierr )
           ENDIF
-
           myindex = 1
           IF ( ar%nrdims == 2 )  THEN
-
              CALL C_F_POINTER( ar%data, data_2d, ar%a_dim(1:2) )
-
              DO  ij = 1, ape%nrele
                 data_2d(ape%locind(ij)%j,ape%locind(ij)%i) = buf(myindex)
                 myindex = myindex + 1
              ENDDO
-
           ELSEIF ( ar%nrdims == 3 )  THEN
-
              CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3) )
-
              DO  ij = 1, ape%nrele
                 data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i) =                  &
@@ -800,9 +747,6 @@
                 myindex = myindex+ar%a_dim(1)
              ENDDO
-
-          ENDIF
-
+          ENDIF
        ENDDO
-
     ENDDO
 
@@ -849,29 +793,20 @@
 
     DO  ip = 1, me%inter_npes
-
        ape => me%pes(ip)
-
        DO  j = 1, ape%nr_arrays
-
           ar => aPE%array_list(j)
           myindex = 1
-
           IF ( ar%nrdims == 2 )  THEN
-
              buf_shape(1) = ape%nrele
              CALL C_F_POINTER( ar%sendbuf, buf,     buf_shape     )
              CALL C_F_POINTER( ar%data,    data_2d, ar%a_dim(1:2) )
-
              DO  ij = 1, ape%nrele
                 buf(myindex) = data_2d(ape%locind(ij)%j,ape%locind(ij)%i)
                 myindex = myindex + 1
              ENDDO
-
           ELSEIF ( ar%nrdims == 3 )  THEN
-
              buf_shape(1) = ape%nrele*ar%a_dim(1)
              CALL C_F_POINTER( ar%sendbuf, buf,     buf_shape     )
              CALL C_F_POINTER( ar%data,    data_3d, ar%a_dim(1:3) )
-
              DO  ij = 1, ape%nrele
                 buf(myindex:myindex+ar%a_dim(1)-1) =                            &
@@ -879,11 +814,7 @@
                 myindex = myindex + ar%a_dim(1)
              ENDDO
-
-          ENDIF
-
+          ENDIF
        ENDDO
-
-    ENDDO
-
+    ENDDO
 !
 !-- TODO: Fence might do it, test later
