Index: palm/trunk/SOURCE/pmc_client_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_client_mod.f90	(revision 1895)
+++ palm/trunk/SOURCE/pmc_client_mod.f90	(revision 1896)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! ------------------
-! 
+! re-formatted to match PALM style
 ! 
 ! Former revisions:
@@ -69,5 +69,5 @@
 #if defined( __parallel )
 
-    use, intrinsic :: iso_c_binding
+    USE, INTRINSIC ::  iso_c_binding
 
 #if defined( __mpifh )
@@ -76,633 +76,799 @@
     USE MPI
 #endif
-    USE  kinds
-    USE  PMC_general,   ONLY: ClientDef, DA_NameDef, DA_Namelen, PMC_STATUS_OK, PMC_DA_NAME_ERR, PeDef, ArrayDef, &
-                                         DA_Desclen, DA_Namelen, PMC_G_SetName, PMC_MAX_ARRAY
-    USE  PMC_handle_communicator,   ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_server_comm
-    USE  PMC_MPI_wrapper,           ONLY: PMC_Send_to_Server, PMC_Recv_from_Server, PMC_Time,                     &
-                                              PMC_Bcast, PMC_Inter_Bcast, PMC_Alloc_mem
-    IMPLICIT none
+
+    USE kinds
+    USE pmc_general,                                                           &
+        ONLY:  arraydef, clientdef, da_desclen, da_namedef, da_namelen, pedef, &
+               pmc_da_name_err,  pmc_g_setname, pmc_max_array, pmc_status_ok
+
+    USE pmc_handle_communicator,                                               &
+        ONLY:  m_model_comm, m_model_npes, m_model_rank, m_to_server_comm
+
+    USE pmc_mpi_wrapper,                                                       &
+        ONLY:  pmc_alloc_mem, pmc_bcast, pmc_inter_bcast,                      &
+               pmc_recv_from_server, pmc_send_to_server, pmc_time
+
+    IMPLICIT NONE
+
     PRIVATE
     SAVE
 
-    Type(ClientDef)                       :: me
-
-    INTEGER                               :: next_array_in_list = 0
-    INTEGER                               :: myIndex = 0                !Counter and unique number for Data Arrays
-
-    ! INTERFACE section
-
-    INTERFACE PMC_ClientInit
-        MODULE procedure PMC_ClientInit
+    TYPE(clientdef) ::  me   !<
+
+    INTEGER ::  myindex = 0         !< counter and unique number for data arrays
+    INTEGER ::  next_array_in_list = 0   !<
+
+
+    INTERFACE pmc_clientinit
+        MODULE PROCEDURE pmc_clientinit
     END INTERFACE PMC_ClientInit
 
-    INTERFACE PMC_Set_DataArray_Name
-        MODULE procedure PMC_Set_DataArray_Name
-        MODULE procedure PMC_Set_DataArray_Name_LastEntry
-    END INTERFACE PMC_Set_DataArray_Name
-
-    INTERFACE PMC_C_Get_2D_index_list
-        MODULE procedure PMC_C_Get_2D_index_list
-    END INTERFACE PMC_C_Get_2D_index_list
-
-    INTERFACE PMC_C_clear_next_array_list
-        MODULE procedure PMC_C_clear_next_array_list
-    END INTERFACE PMC_C_clear_next_array_list
-
-    INTERFACE PMC_C_GetNextArray
-        MODULE procedure PMC_C_GetNextArray
-    END INTERFACE PMC_C_GetNextArray
-
-    INTERFACE PMC_C_Set_DataArray
-        MODULE procedure PMC_C_Set_DataArray_2d
-        MODULE procedure PMC_C_Set_DataArray_3d
-    END INTERFACE PMC_C_Set_DataArray
-
-    INTERFACE PMC_C_setInd_and_AllocMem
-        MODULE procedure PMC_C_setInd_and_AllocMem
-    END INTERFACE PMC_C_setInd_and_AllocMem
-
-    INTERFACE PMC_C_GetBuffer
-        MODULE procedure PMC_C_GetBuffer
-    END INTERFACE PMC_C_GetBuffer
-
-    INTERFACE PMC_C_PutBuffer
-        MODULE procedure PMC_C_PutBuffer
-    END INTERFACE PMC_C_PutBuffer
-
-    ! Public section
-
-    PUBLIC PMC_ClientInit , PMC_Set_DataArray_Name, PMC_C_Get_2D_index_list
-    PUBLIC PMC_C_GetNextArray, PMC_C_Set_DataArray, PMC_C_clear_next_array_list
-    PUBLIC PMC_C_setInd_and_AllocMem , PMC_C_GetBuffer, PMC_C_PutBuffer
-
-CONTAINS
-
-    SUBROUTINE PMC_ClientInit
-        IMPLICIT none
-
-        INTEGER                       :: i
-        INTEGER                       :: istat
-
-
-        ! Tailor MPI environment
-
-        me%model_comm = m_model_comm
-        me%inter_comm = m_to_server_comm
-
-        ! Get rank and size
-        CALL MPI_Comm_rank (me%model_comm, me%model_rank, istat);
-        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
-        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 for all Server PEs an array of TYPE ArrayDef to store information of transfer array
-        do i=1,me%inter_npes
-           ALLOCATE(me%PEs(i)%array_list(PMC_MAX_ARRAY))
-        end do
-
-!        if(me%model_rank == 0) write(0,'(a,5i6)') 'PMC_ClientInit ',me%model_rank,me%model_npes,me%inter_npes,me%intra_rank
-
-        return
-    END SUBROUTINE PMC_ClientInit
-
-    SUBROUTINE PMC_Set_DataArray_Name (ServerArrayDesc, ServerArrayName, ClientArrayDesc, ClientArrayName, istat)
-        IMPLICIT none
-        character(len=*),INTENT(IN)           :: ServerArrayName
-        character(len=*),INTENT(IN)           :: ServerArrayDesc
-        character(len=*),INTENT(IN)           :: ClientArrayName
-        character(len=*),INTENT(IN)           :: ClientArrayDesc
-        INTEGER,INTENT(OUT)                   :: istat
-
-        !-- local variables
-        type(DA_NameDef)                      :: myName
-        INTEGER                               :: myPe
-        INTEGER                               :: my_AddiArray=0
-
-        istat = PMC_STATUS_OK
-        if(len(trim(ServerArrayName)) > DA_Namelen .or.                                         &
-            len(trim(ClientArrayName)) > DA_Namelen)  then !Name too long
-            istat = PMC_DA_NAME_ERR
-        end if
-
-        if(m_model_rank == 0) then
-            myIndex = myIndex+1
-            myName%couple_index  = myIndex
-            myName%ServerDesc    = trim(ServerArrayDesc)
-            myName%NameOnServer  = trim(ServerArrayName)
-            myName%ClientDesc    = trim(ClientArrayDesc)
-            myName%NameOnClient  = trim(ClientArrayName)
-        end if
-
-        !   Broadcat to all Client PEs
-
-        CALL PMC_Bcast ( myName%couple_index,  0,   comm=m_model_comm)
-        CALL PMC_Bcast ( myName%ServerDesc, 0,      comm=m_model_comm)
-        CALL PMC_Bcast ( myName%NameOnServer,    0, comm=m_model_comm)
-        CALL PMC_Bcast ( myName%ClientDesc, 0,      comm=m_model_comm)
-        CALL PMC_Bcast ( myName%NameOnClient,    0, comm=m_model_comm)
-
-        !   Broadcat to all Server PEs
-
-        if(m_model_rank == 0) then
-            myPE = MPI_ROOT
-        else
-            myPE = MPI_PROC_NULL
-        endif
-        CALL PMC_Bcast ( myName%couple_index, myPE, comm=m_to_server_comm)
-        CALL PMC_Bcast ( myName%ServerDesc,   myPE, comm=m_to_server_comm)
-        CALL PMC_Bcast ( myName%NameOnServer, myPE, comm=m_to_server_comm)
-        CALL PMC_Bcast ( myName%ClientDesc,   myPE, comm=m_to_server_comm)
-        CALL PMC_Bcast ( myName%NameOnClient, myPE, comm=m_to_server_comm)
-
-        CALL PMC_G_SetName (me, myName%couple_index, myName%NameOnClient)
-
-        return
-    END SUBROUTINE PMC_Set_DataArray_Name
-
-    SUBROUTINE PMC_Set_DataArray_Name_LastEntry (LastEntry)
-        IMPLICIT none
-        LOGICAL,INTENT(IN),optional           :: LastEntry
-
-        !-- local variables
-        type(DA_NameDef)                      :: myName
-        INTEGER                               :: myPe
-
-        myName%couple_index  = -1
-
-        if(m_model_rank == 0) then
-            myPE = MPI_ROOT
-        else
-            myPE = MPI_PROC_NULL
-        endif
-        CALL PMC_Bcast ( myName%couple_index,  myPE, comm=m_to_server_comm)
-
-        return
-    END SUBROUTINE PMC_Set_DataArray_Name_LastEntry
-
-    SUBROUTINE PMC_C_Get_2D_index_list
-       IMPLICIT none
-
-       INTEGER                                 :: i,j,i2,nr,ierr
-       INTEGER                                 :: dummy
-       INTEGER                                 :: indWin          !: MPI window object
-       INTEGER                                 :: indWin2         !: MPI window object
-       INTEGER(KIND=MPI_ADDRESS_KIND)          :: win_size        !: Size of MPI window 1 (in bytes)
-       INTEGER(KIND=MPI_ADDRESS_KIND)          :: disp            !: Displacement Unit (Integer = 4, floating poit = 8
-       INTEGER,DIMENSION(me%inter_npes*2)      :: NrEle           !: Number of Elements of a horizontal slice
-       TYPE(PeDef),POINTER                     :: aPE             !: Pointer to PeDef structure
-       INTEGER(KIND=MPI_ADDRESS_KIND)          :: WinSize         !: Size of MPI window 2 (in bytes)
-       INTEGER,DIMENSION(:),POINTER            :: myInd
-
-!      CALL PMC_C_CGet_Rem_index_list
-
-       win_size = c_sizeof(dummy)
-       CALL MPI_Win_create (dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm, indWin, ierr);
-       CALL MPI_Win_fence (0, indWin, ierr)                ! Open Window on Server side
-       CALL MPI_Win_fence (0, indWin, ierr)                ! Close Window on Server Side and opem on Client side
-
-       do i=1,me%inter_npes
-          disp = me%model_rank*2
-          CALL MPI_Get (NrEle((i-1)*2+1),2,MPI_INTEGER,i-1,disp,2,MPI_INTEGER,indWin, ierr)
-       end do
-       CALL MPI_Win_fence (0, indWin, ierr)    ! MPI_get is Non-blocking -> data in NrEle is not available until MPI_fence CALL
-
-       WinSize = 0
-       do i=1,me%inter_npes                         !Allocate memory for index array
-         aPE => me%PEs(i)
-         i2 = (i-1)*2+1
-         nr = NrEle(i2+1)
-         if(nr > 0)  then
-            ALLOCATE(aPE%locInd(nr))
-         else
-            NULLIFY (aPE%locInd)
-         endif
-         WinSize = max(nr,WinSize)                  !Maximum window size
-       end do
-
-       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 MPI Window because the server PEs 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);
-
-       CALL MPI_Win_fence (0, indWin2, ierr)    ! MPI_get is Non-blocking -> data in NrEle is not available until MPI_fence CALL
-       CALL MPI_Win_fence (0, indWin2, ierr)    ! MPI_get is Non-blocking -> data in NrEle is not available until MPI_fence CALL
-
-       do i=1,me%inter_npes
-          aPE => me%PEs(i)
-          nr = NrEle(i*2)
-          if(nr > 0 )  then
-             disp = NrEle(2*(i-1)+1)
-             CALL MPI_Win_lock (MPI_LOCK_SHARED , i-1, 0, indWin2, ierr)
-             CALL MPI_Get (myInd,2*nr,MPI_INTEGER,i-1,disp,2*nr,MPI_INTEGER,indWin2, ierr)
-             CALL MPI_Win_unlock (i-1, indWin2, ierr)
-             do j=1,nr
-                aPE%locInd(j)%i = myInd(2*j-1)
-                aPE%locInd(j)%j = myInd(2*j)
-             end do
-             aPE%NrEle = nr
-          else
-             aPE%NrEle = -1
-          end if
-       end do
-
-       CALL MPI_Barrier(me%intra_comm, ierr)   ! Dont know why, but this barrier is necessary before we can free the windows
-
-       CALL MPI_Win_free(indWin, ierr);
-       CALL MPI_Win_free(indWin2, ierr);
-       DEALLOCATE (myInd)
-
-       return
-    END SUBROUTINE PMC_C_Get_2D_index_list
-
-    SUBROUTINE PMC_C_clear_next_array_list
-       IMPLICIT none
-
-       next_array_in_list = 0
-
-       return
-    END SUBROUTINE PMC_C_clear_next_array_list
-
-!   List handling is still required to get minimal interaction with pmc_interface
-    LOGICAL function PMC_C_GetNextArray (myName)
-        character(len=*),INTENT(OUT)               :: myName
-
-        !-- local variables
-       TYPE(PeDef),POINTER          :: aPE
-       TYPE(ArrayDef),POINTER       :: ar
-
-       next_array_in_list = next_array_in_list+1
-
-!--    Array Names are the same on all client PE, so take first PE to get the name
-       aPE => me%PEs(1)
-
-       if(next_array_in_list > aPE%Nr_arrays) then
-          PMC_C_GetNextArray = .false.             !all arrays done
-          return
-       end if
-
-       ar  => aPE%array_list(next_array_in_list)
-
-       myName = ar%name
-
-       PMC_C_GetNextArray =  .true.                ! Return true if legal array
-       return
-    END function PMC_C_GetNextArray
-
-    SUBROUTINE PMC_C_Set_DataArray_2d (array)
-
-       IMPLICIT none
-
-       REAL(wp), INTENT(IN) ,DIMENSION(:,:), POINTER ::  array
-
-       INTEGER                              :: NrDims
-       INTEGER,DIMENSION (4)                :: dims
-       TYPE(c_ptr)                          :: array_adr
-       INTEGER                              :: i
-       TYPE(PeDef),POINTER                  :: aPE
-       TYPE(ArrayDef),POINTER               :: ar
-
-
-       dims = 1
-
-       NrDims    = 2
-       dims(1)   = size(array,1)
-       dims(2)   = size(array,2)
-
-       array_adr = c_loc(array)
-
-       do i=1,me%inter_npes
-          aPE => me%PEs(i)
-          ar  => aPE%array_list(next_array_in_list)
-          ar%NrDims    = NrDims
-          ar%A_dim     = dims
-          ar%data      = array_adr
-       end do
-
-       return
-    END SUBROUTINE PMC_C_Set_DataArray_2d
-
-    SUBROUTINE PMC_C_Set_DataArray_3d (array)
-
-       IMPLICIT none
-
-       REAL(wp),INTENT(IN),DIMENSION(:,:,:), POINTER ::  array
-
-       INTEGER                              ::  NrDims
-       INTEGER,DIMENSION (4)                ::  dims
-       TYPE(c_ptr)                          ::  array_adr
-       INTEGER                              ::  i
-       TYPE(PeDef),POINTER                  ::  aPE
-       TYPE(ArrayDef),POINTER               ::  ar
-
-       dims = 1
-
-       NrDims    = 3
-       dims(1)   = size(array,1)
-       dims(2)   = size(array,2)
-       dims(3)   = size(array,3)
-
-       array_adr = c_loc(array)
-
-       do i=1,me%inter_npes
-          aPE => me%PEs(i)
-          ar  => aPE%array_list(next_array_in_list)
-          ar%NrDims    = NrDims
-          ar%A_dim     = dims
-          ar%data      = array_adr
-       end do
-
-       return
-    END SUBROUTINE PMC_C_Set_DataArray_3d
-
-   SUBROUTINE PMC_C_setInd_and_AllocMem
-
-      IMPLICIT none
-
-!--   naming convention:  appending       _sc  -> server to client transfer
-!--                                       _cs  -> client to server transfer
-!--                                       Recv -> server to client transfer
-!--                                       Send -> client to server transfer
-
-      INTEGER                                 :: i, istat, ierr, j
-      INTEGER,PARAMETER                       :: NoINdex=-1
-      INTEGER                                 :: rcount
-      INTEGER                                 :: arlen, myIndex, tag
-      INTEGER(idp)                            :: bufsize                   ! Size of MPI data Window
-      TYPE(PeDef),POINTER                     :: aPE
-      TYPE(ArrayDef),POINTER                  :: ar
-      INTEGER,DIMENSION(1024)                 :: req
-      character(len=DA_Namelen)               :: myName
-      Type(c_ptr)                             :: base_ptr
-      REAL(kind=wp),DIMENSION(:),POINTER,save :: base_array_sc             !Base array
-      REAL(kind=wp),DIMENSION(:),POINTER,save :: base_array_cs             !Base array
-      INTEGER(KIND=MPI_ADDRESS_KIND)          :: WinSize
-
-      myIndex = 0
-      bufsize = 8
-
-!--   Server to client 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 client
-            tag = tag+1
-            CALL MPI_Recv (myIndex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, MPI_STATUS_IGNORE, ierr)
-
-            if(ar%NrDims == 3) then
-               bufsize = max(bufsize,ar%A_dim(1)*ar%A_dim(2)*ar%A_dim(3))    ! determine max, because client buffer is allocated only once
-            else
-               bufsize = max(bufsize,ar%A_dim(1)*ar%A_dim(2))
-            end if
-            ar%RecvIndex = myIndex
-
-           end do
-      end do
-
-
-!--   Create RMA (One Sided Communication) data buffer
-!--   The buffer for MPI_Get can be PE local, i.e. it can but must not be part of the MPI RMA window
-
-      CALL PMC_Alloc_mem (base_array_sc, 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
-         end do
-      end do
-
-!--   Client to server direction
-
-      myIndex = 1
-      rCount  = 0
-      bufsize = 8
-
-      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
-               arlen     = aPE%NrEle                        ! 2D
-            else if(ar%NrDims == 3) then
-               arlen     = aPE%NrEle*ar%A_dim(1)            ! 3D
-            end if
-
-            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
-            end if
-
-            if(rCount == 1024) then                                  ! Maximum of 1024 outstanding requests
-               CALL MPI_Waitall (rCount, req, MPI_STATUSES_IGNORE, ierr)
-               rCount = 0;
-            end if
-
-            if(aPE%NrEle > 0)  then
-               ar%SendSize  = arlen
-               myIndex     = myIndex+arlen
-               bufsize     = bufsize+arlen
-            end if
-          end do
-         if(rCount > 0) then                                          ! Wait for all send completed
-            CALL MPI_Waitall (rCount, req, MPI_STATUSES_IGNORE, ierr)
-         end if
-      end do
-
-!--   Create RMA (One Sided Communication) window for data buffer client to server transfer
-!--   The buffer of MPI_Get (counter part of transfer) can be PE-local, i.e. it can but must not be part of the MPI RMA window
-!--   Only one RMA window is required to prepare the data for server -> client transfer on the server side and
-!--                                                       for client -> server transfer on the client side
-
-      CALL PMC_Alloc_mem (base_array_cs, bufsize)
-      me%TotalBufferSize = bufsize*wp                          !Total buffer size in Byte
-
-      WinSize = me%TotalBufferSize
-      CALL MPI_Win_create (base_array_cs, WinSize, wp, MPI_INFO_NULL, me%intra_comm, me%win_server_client, ierr);
-      CALL MPI_Win_fence (0, me%win_server_client, ierr);                    !  Open Window to set data
-      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)
-            if(aPE%NrEle > 0)  then
-              ar%SendBuf = c_loc(base_array_cs(ar%SendIndex))
-              if(ar%SendIndex+ar%SendSize > bufsize) then
-                 write(0,'(a,i4,4i7,1x,a)') 'Client Buffer too small ',i,      &
-                     ar%SendIndex,ar%SendSize,ar%SendIndex+ar%SendSize,bufsize,trim(ar%name)
-                 CALL MPI_Abort (MPI_COMM_WORLD, istat, ierr)
-              end if
-            end if
-         end do
-      end do
-
-      return
-   END SUBROUTINE PMC_C_setInd_and_AllocMem
-
-   SUBROUTINE PMC_C_GetBuffer (WaitTime)
-
-      IMPLICIT none
-
-      REAL(wp), INTENT(OUT), optional   ::  WaitTime
-
-      !-- local variables
-      INTEGER                           ::  ip, ij, ierr, j
-      INTEGER                           ::  nr  ! Number of Elements to getb from server
-      INTEGER                           ::  myIndex
-      REAL(wp)                          ::  t1,t2
-      TYPE(PeDef),POINTER               ::  aPE
-      TYPE(ArrayDef),POINTER            ::  ar
-      INTEGER,DIMENSION(1)              ::  buf_shape
-      REAL(wp),POINTER,DIMENSION(:)     ::  buf
-      REAL(wp),POINTER,DIMENSION(:,:)   ::  data_2d
-      REAL(wp),POINTER,DIMENSION(:,:,:) ::  data_3d
-      character(len=DA_Namelen)         ::  myName
-      INTEGER(kind=MPI_ADDRESS_KIND)    ::  target_disp
-
-!
-!--   Synchronization of the model is done in pmci_client_synchronize and pmci_server_synchronize
-!--   Therefor the RMA window can be filled without sychronization at this point and a barrier
-!--   is not necessary
-!--   Please note that WaitTime has to be set in PMC_S_FillBuffer AND PMC_C_GetBuffer
-      if(present(WaitTime))  then
-         t1 = PMC_Time()
-         CALL MPI_Barrier(me%intra_comm, ierr)
-         t2 = PMC_Time()
-         WaitTime = t2-t1
-      end if
-
-      CALL MPI_Barrier(me%intra_comm, ierr)                         ! Wait for buffer is filled
-
-      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
-            else if(ar%NrDims == 3) then
-               nr = aPE%NrEle*ar%A_dim(1)
-            end if
-
-            buf_shape(1) = nr
-            CALL c_f_pointer(ar%RecvBuf, buf, buf_shape)
-!
-!--         MPI passive target RMA
-            if(nr > 0)   then
-               target_disp = (ar%RecvIndex-1)
-               CALL MPI_Win_lock (MPI_LOCK_SHARED , ip-1, 0, me%win_server_client, ierr)
-               CALL MPI_Get (buf, nr, MPI_REAL, ip-1, target_disp, nr, MPI_REAL, me%win_server_client, ierr)
-               CALL MPI_Win_unlock (ip-1, me%win_server_client, ierr)
-            end if
-
-            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
-               end do
-            else if(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) = buf(myIndex:myIndex+ar%A_dim(1)-1)
-                  myIndex = myIndex+ar%A_dim(1)
-               end do
-            end if
-
-         end do
-      end do
-      return
-   END SUBROUTINE PMC_C_GetBuffer
-
-   SUBROUTINE PMC_C_PutBuffer (WaitTime)
-
-      IMPLICIT none
-
-      REAL(wp), INTENT(OUT), optional   :: WaitTime
-
-      !-- local variables
-      INTEGER                           ::  ip, ij, ierr, j
-      INTEGER                           ::  nr  ! Number of Elements to getb from server
-      INTEGER                           ::  myIndex
-      REAL(wp)                          ::  t1,t2
-      TYPE(PeDef),POINTER               ::  aPE
-      TYPE(ArrayDef),POINTER            ::  ar
-      INTEGER,DIMENSION(1)              ::  buf_shape
-      REAL(wp),POINTER,DIMENSION(:)     ::  buf
-      REAL(wp),POINTER,DIMENSION(:,:)   ::  data_2d
-      REAL(wp),POINTER,DIMENSION(:,:,:) ::  data_3d
-      character(len=DA_Namelen)         ::  myName
-      INTEGER(kind=MPI_ADDRESS_KIND)    ::  target_disp
-
-      t1 = PMC_Time()
-      CALL MPI_Barrier(me%intra_comm, ierr)              ! Wait for empty buffer
-      t2 = PMC_Time()
-      if(present(WaitTime)) WaitTime = t2-t1
-
-      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
-               end do
-            else if(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) = data_3d(:,aPE%locInd(ij)%j,aPE%locInd(ij)%i)
-                  myIndex = myIndex+ar%A_dim(1)
-               end do
-            end if
-          end do
-      end do
-
-
-!      CALL MPI_Win_fence (0, me%win_server_client, ierr)      ! Fence might do it, test later
-      CALL MPI_Barrier(me%intra_comm, ierr)                   ! buffer is filled
-
-      return
-    END SUBROUTINE PMC_C_PutBuffer
+    INTERFACE pmc_c_clear_next_array_list
+        MODULE PROCEDURE pmc_c_clear_next_array_list
+    END INTERFACE pmc_c_clear_next_array_list
+
+    INTERFACE pmc_c_getbuffer
+        MODULE PROCEDURE pmc_c_getbuffer
+    END INTERFACE pmc_c_getbuffer
+
+    INTERFACE pmc_c_getnextarray
+        MODULE PROCEDURE pmc_c_getnextarray
+    END INTERFACE pmc_c_getnextarray
+
+    INTERFACE pmc_c_get_2d_index_list
+        MODULE PROCEDURE pmc_c_get_2d_index_list
+    END INTERFACE pmc_c_get_2d_index_list
+
+    INTERFACE pmc_c_putbuffer
+        MODULE PROCEDURE pmc_c_putbuffer
+    END INTERFACE pmc_c_putbuffer
+
+    INTERFACE pmc_c_setind_and_allocmem
+        MODULE PROCEDURE pmc_c_setind_and_allocmem
+    END INTERFACE pmc_c_setind_and_allocmem
+
+    INTERFACE pmc_c_set_dataarray
+        MODULE PROCEDURE pmc_c_set_dataarray_2d
+        MODULE PROCEDURE pmc_c_set_dataarray_3d
+    END INTERFACE pmc_c_set_dataarray
+
+    INTERFACE pmc_set_dataarray_name
+        MODULE PROCEDURE pmc_set_dataarray_name
+        MODULE PROCEDURE pmc_set_dataarray_name_lastentry
+    END INTERFACE pmc_set_dataarray_name
+
+
+    PUBLIC pmc_clientinit, pmc_c_clear_next_array_list, pmc_c_getbuffer,       &
+           pmc_c_getnextarray, pmc_c_putbuffer, pmc_c_setind_and_allocmem,     &
+           pmc_c_set_dataarray, pmc_set_dataarray_name, pmc_c_get_2d_index_list
+
+ CONTAINS
+
+
+
+ SUBROUTINE pmc_clientinit
+
+     IMPLICIT NONE
+
+     INTEGER ::  i        !<
+     INTEGER ::  istat    !<
+
+!
+!--  Get / define the MPI environment
+     me%model_comm = m_model_comm
+     me%inter_comm = m_to_server_comm
+
+     CALL MPI_COMM_RANK( me%model_comm, me%model_rank, istat )
+     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
+     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 server PEs to store information
+!--  of then transfer array
+     DO  i = 1, me%inter_npes
+        ALLOCATE( me%pes(i)%array_list(pmc_max_array) )
+     ENDDO
+
+ END SUBROUTINE pmc_clientinit
+
+
+
+ SUBROUTINE pmc_set_dataarray_name( serverarraydesc, serverarrayname,          &
+                                    clientarraydesc, clientarrayname, istat )
+
+    IMPLICIT NONE
+
+    CHARACTER(LEN=*), INTENT(IN) ::  serverarrayname  !<
+    CHARACTER(LEN=*), INTENT(IN) ::  serverarraydesc  !<
+    CHARACTER(LEN=*), INTENT(IN) ::  clientarrayname  !<
+    CHARACTER(LEN=*), INTENT(IN) ::  clientarraydesc  !<
+
+    INTEGER, INTENT(OUT) ::  istat  !<
+
+!
+!-- Local variables
+    TYPE(da_namedef) ::  myname  !<
+
+    INTEGER ::  mype  !<
+    INTEGER ::  my_addiarray = 0  !<
+
+
+    istat = pmc_status_ok
+!
+!-- Check length of array names
+    IF ( LEN( TRIM( serverarrayname) ) > da_namelen  .OR.                     &
+         LEN( TRIM( clientarrayname) ) > da_namelen )  THEN
+       istat = pmc_da_name_err
+    ENDIF
+
+    IF ( m_model_rank == 0 )  THEN
+       myindex = myindex + 1
+       myname%couple_index = myIndex
+       myname%serverdesc   = TRIM( serverarraydesc )
+       myname%nameonserver = TRIM( serverarrayname )
+       myname%clientdesc   = TRIM( clientarraydesc )
+       myname%nameonclient = TRIM( clientarrayname )
+    ENDIF
+
+!
+!-- Broadcat to all client PEs
+!-- TODO: describe what is broadcast here and why it is done
+    CALL pmc_bcast( myname%couple_index, 0, comm=m_model_comm )
+    CALL pmc_bcast( myname%serverdesc,   0, comm=m_model_comm )
+    CALL pmc_bcast( myname%nameonserver, 0, comm=m_model_comm )
+    CALL pmc_bcast( myname%clientdesc,   0, comm=m_model_comm )
+    CALL pmc_bcast( myname%nameonclient, 0, comm=m_model_comm )
+
+!
+!-- Broadcat to all server PEs
+!-- TODO: describe what is broadcast here and why it is done
+    IF ( m_model_rank == 0 )  THEN
+        mype = MPI_ROOT
+    ELSE
+        mype = MPI_PROC_NULL
+    ENDIF
+
+    CALL pmc_bcast( myname%couple_index, mype, comm=m_to_server_comm )
+    CALL pmc_bcast( myname%serverdesc,   mype, comm=m_to_server_comm )
+    CALL pmc_bcast( myname%nameonserver, mype, comm=m_to_server_comm )
+    CALL pmc_bcast( myname%clientdesc,   mype, comm=m_to_server_comm )
+    CALL pmc_bcast( myname%nameonclient, mype, comm=m_to_server_comm )
+
+    CALL pmc_g_setname( me, myname%couple_index, myname%nameonclient )
+
+ END SUBROUTINE pmc_set_dataarray_name
+
+
+
+ SUBROUTINE pmc_set_dataarray_name_lastentry( lastentry )
+
+    IMPLICIT NONE
+
+    LOGICAL, INTENT(IN), OPTIONAL ::  lastentry  !<
+
+!
+!-- Local variables
+    INTEGER ::  mype  !<
+    TYPE(dA_namedef) ::  myname  !<
+
+    myname%couple_index = -1
+
+    IF ( m_model_rank == 0 )  THEN
+       mype = MPI_ROOT
+    ELSE
+       mype = MPI_PROC_NULL
+    ENDIF
+
+    CALL pmc_bcast( myname%couple_index, mype, comm=m_to_server_comm )
+
+ END SUBROUTINE pmc_set_dataarray_name_lastentry
+
+
+
+ SUBROUTINE pmc_c_get_2d_index_list
+
+    IMPLICIT NONE
+
+    INTEGER :: dummy               !<
+    INTEGER :: i, ierr, i2, j, nr  !<
+    INTEGER :: indwin              !< MPI window object
+    INTEGER :: indwin2  !          < MPI window object
+
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: win_size !< Size of MPI window 1 (in bytes)
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: disp     !< Displacement unit (Integer = 4, floating poit = 8
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: winsize  !< Size of MPI window 2 (in bytes)
+
+    INTEGER, DIMENSION(me%inter_npes*2) :: nrele  !< Number of Elements of a
+                                                  !< horizontal slice
+    INTEGER, DIMENSION(:), POINTER ::  myind  !<
+
+    TYPE(pedef), POINTER ::  ape  !> Pointer to pedef structure
+
+
+    win_size = C_SIZEOF( dummy )
+    CALL MPI_WIN_CREATE( dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm,   &
+                         indwin, ierr )
+!
+!-- Open window on server side
+!-- TODO: why is the next MPI routine called twice??
+    CALL MPI_WIN_FENCE( 0, indwin, ierr )
+!
+!-- Close window on server side and open on client side
+    CALL MPI_WIN_FENCE( 0, indwin, ierr )
+
+    DO  i = 1, me%inter_npes
+       disp = me%model_rank * 2
+       CALL MPI_GET( nrele((i-1)*2+1), 2, MPI_INTEGER, i-1, disp, 2,           &
+                     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
+    winsize = 0
+    DO  i = 1, me%inter_npes
+       ape => me%pes(i)
+       i2 = ( i-1 ) * 2 + 1
+       nr = nrele(i2+1)
+       IF ( nr > 0 )  THEN
+          ALLOCATE( ape%locind(nr) )
+       ELSE
+          NULLIFY( ape%locind )
+       ENDIF
+       winsize = MAX( nr, winsize )
+    ENDDO
+
+    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 server PEs 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
+!-- called
+!-- TODO: as before: why is this called twice??
+    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
+    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
+
+    DO  i = 1, me%inter_npes
+       ape => me%pes(i)
+       nr = nrele(i*2)
+       IF ( nr > 0 )  THEN
+          disp = nrele(2*(i-1)+1)
+          CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , i-1, 0, indwin2, ierr )
+          CALL MPI_GET( myind, 2*nr, MPI_INTEGER, i-1, disp, 2*nr,             &
+                        MPI_INTEGER, indwin2, ierr )
+          CALL MPI_WIN_UNLOCK( i-1, indwin2, ierr )
+          DO  j = 1, nr
+             ape%locind(j)%i = myind(2*j-1)
+             ape%locind(j)%j = myind(2*j)
+          ENDDO
+          ape%nrele = nr
+       ELSE
+          ape%nrele = -1
+       ENDIF
+    ENDDO
+
+!
+!-- Don't know why, but this barrier is necessary before we can free the windows
+    CALL MPI_BARRIER( me%intra_comm, ierr )
+
+    CALL MPI_WIN_FREE( indWin,  ierr )
+    CALL MPI_WIN_FREE( indwin2, ierr )
+    DEALLOCATE( myind )
+
+ END SUBROUTINE pmc_c_get_2d_index_list
+
+
+
+ SUBROUTINE pmc_c_clear_next_array_list
+
+    IMPLICIT NONE
+
+    next_array_in_list = 0
+
+ END SUBROUTINE pmc_c_clear_next_array_list
+
+
+
+ LOGICAL FUNCTION pmc_c_getnextarray( myname )
+!
+!--  List handling is still required to get minimal interaction with
+!--  pmc_interface
+     CHARACTER(LEN=*), INTENT(OUT) ::  myname  !<
+
+!
+!-- Local variables
+    TYPE(pedef), POINTER    :: ape
+    TYPE(arraydef), POINTER :: ar
+
+
+    next_array_in_list = next_array_in_list + 1
+
+!
+!-- Array names are the same on all client PEs, so take first PE to get the name
+    ape => me%pes(1)
+!
+!-- Check if all arrays have been processed
+    IF ( next_array_in_list > ape%nr_arrays )  THEN
+       pmc_c_getnextarray = .FALSE.
+       RETURN
+    ENDIF
+
+    ar => ape%array_list( next_array_in_list )
+
+    myname = ar%name
+
+!
+!-- Return true if legal array
+!-- TODO: the case of a non-legal array does not seem to appear, so why is this
+!-- setting required at all?
+    pmc_c_getnextarray = .TRUE.
+
+ END function pmc_c_getnextarray
+
+
+
+ SUBROUTINE pmc_c_set_dataarray_2d( array )
+
+    IMPLICIT NONE
+
+    REAL(wp), INTENT(IN) , DIMENSION(:,:), POINTER ::  array  !<
+
+    INTEGER                 ::  i       !<
+    INTEGER                 ::  nrdims  !<
+    INTEGER, DIMENSION(4)   ::  dims    !<
+
+    TYPE(C_PTR)             ::  array_adr
+    TYPE(arraydef), POINTER ::  ar
+    TYPE(pedef), POINTER    ::  ape
+
+
+    dims    = 1
+    nrdims  = 2
+    dims(1) = SIZE( array, 1 )
+    dims(2) = SIZE( array, 2 )
+
+    array_adr = C_LOC( array )
+
+    DO  i = 1, me%inter_npes
+       ape => me%pes(i)
+       ar  => ape%array_list(next_array_in_list)
+       ar%nrdims = nrdims
+       ar%a_dim  = dims
+       ar%data   = array_adr
+    ENDDO
+
+ END SUBROUTINE pmc_c_set_dataarray_2d
+
+
+
+ SUBROUTINE pmc_c_set_dataarray_3d (array)
+
+    IMPLICIT NONE
+
+    REAL(wp), INTENT(IN), DIMENSION(:,:,:), POINTER ::  array  !<
+
+    INTEGER                 ::  i
+    INTEGER                 ::  nrdims
+    INTEGER, DIMENSION (4)  ::  dims
+    TYPE(C_PTR)             ::  array_adr
+    TYPE(pedef), POINTER    ::  ape
+    TYPE(arraydef), POINTER ::  ar
+
+
+    dims    = 1
+    nrdims  = 3
+    dims(1) = SIZE( array, 1 )
+    dims(2) = SIZE( array, 2 )
+    dims(3) = SIZE( array, 3 )
+
+    array_adr = C_LOC( array )
+
+    DO  i = 1, me%inter_npes
+       ape => me%pes(i)
+       ar  => ape%array_list(next_array_in_list)
+       ar%nrdims = nrdims
+       ar%a_dim  = dims
+       ar%data   = array_adr
+    ENDDO
+
+ END SUBROUTINE pmc_c_set_dataarray_3d
+
+
+
+ SUBROUTINE pmc_c_setind_and_allocmem
+
+    IMPLICIT NONE
+!
+!-- Naming convention for appendices:  _sc  -> server to client transfer
+!--                                    _cs  -> client to server transfer
+!--                                    recv -> server to client transfer
+!--                                    send -> client to server transfer
+    CHARACTER(LEN=da_namelen) ::  myname  !<
+
+    INTEGER ::  arlen    !<
+    INTEGER ::  myindex  !<
+    INTEGER ::  i        !<
+    INTEGER ::  ierr     !<
+    INTEGER ::  istat    !<
+    INTEGER ::  j        !<
+    INTEGER ::  rcount   !<
+    INTEGER ::  tag      !<
+
+    INTEGER, PARAMETER ::  noindex = -1  !<
+
+    INTEGER(idp)                   ::  bufsize  !< size of MPI data window
+    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
+
+    INTEGER,DIMENSION(1024) ::  req  !<
+
+    REAL(wp), DIMENSION(:), POINTER, SAVE ::  base_array_sc  !< base array
+    REAL(wp), DIMENSION(:), POINTER, SAVE ::  base_array_cs  !< base array
+
+    TYPE(pedef), POINTER    ::  ape       !<
+    TYPE(arraydef), POINTER ::  ar        !<
+    Type(C_PTR)             ::  base_ptr  !<
+
+
+    myindex = 0
+    bufsize = 8
+
+!
+!-- Server to client 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 client
+          tag = tag + 1
+          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,     &
+                         MPI_STATUS_IGNORE, ierr )
+          ar%recvindex = myindex
+!
+!--       Determine max, because client buffer is allocated only once
+!--       TODO: give a more meaningful comment
+          IF( ar%nrdims == 3 )  THEN
+             bufsize = MAX( bufsize, ar%a_dim(1)*ar%a_dim(2)*ar%a_dim(3) )
+          ELSE
+             bufsize = MAX( bufsize, ar%a_dim(1)*ar%a_dim(2) )
+          ENDIF
+
+       ENDDO
+
+    ENDDO
+
+!
+!-- Create RMA (one sided communication) data buffer.
+!-- The buffer for MPI_GET can be PE local, i.e. it can but must not be part of
+!-- the MPI RMA window
+    CALL pmc_alloc_mem( base_array_sc, 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
+
+!
+!-- Client to server direction
+    myindex = 1
+    rcount  = 0
+    bufsize = 8
+
+    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
+             arlen = ape%nrele
+          ELSEIF( ar%nrdims == 3 )  THEN
+             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 outstanding requests
+!--       TODO: explain where this maximum comes from (arbitrary?)
+          IF ( rcount == 1024 )  THEN
+             CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
+             rcount = 0
+          ENDIF
+
+          IF ( ape%nrele > 0 )  THEN
+             ar%sendsize = arlen
+             myindex     = myindex + arlen
+             bufsize     = bufsize + arlen
+          ENDIF
+
+       ENDDO
+
+       IF ( rcount > 0 )  THEN
+          CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
+       ENDIF
+
+    ENDDO
+
+!
+!-- Create RMA (one sided communication) window for data buffer client to server
+!-- transfer.
+!-- The buffer of MPI_GET (counter part of transfer) can be PE-local, i.e. it
+!-- can but must not be part of the MPI RMA window. Only one RMA window is
+!-- required to prepare the data
+!--        for server -> client transfer on the server side
+!-- and
+!--        for client -> server transfer on the client side
+
+    CALL pmc_alloc_mem( base_array_cs, bufsize )
+    me%totalbuffersize = bufsize * wp  ! total buffer size in byte
+
+    winSize = me%totalbuffersize
+
+    CALL MPI_WIN_CREATE( base_array_cs, winsize, wp, MPI_INFO_NULL,            &
+                         me%intra_comm, me%win_server_client, ierr )
+    CALL MPI_WIN_FENCE( 0, me%win_server_client, 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)
+
+          IF ( ape%nrele > 0 )  THEN
+             ar%sendbuf = C_LOC( base_array_cs(ar%sendindex) )
+!--          TODO: if this is an error to be really expected, replace the
+!--                following message by a meaningful standard PALM message using
+!--                the message-routine
+             IF ( ar%sendindex+ar%sendsize > bufsize )  THEN
+                WRITE( 0,'(a,i4,4i7,1x,a)') 'Client Buffer too small ', i,     &
+                          ar%sendindex, ar%sendsize, ar%sendindex+ar%sendsize, &
+                          bufsize, TRIM( ar%name )
+                CALL MPI_ABORT( MPI_COMM_WORLD, istat, ierr )
+             ENDIF
+          ENDIF
+
+       ENDDO
+
+    ENDDO
+
+ END SUBROUTINE pmc_c_setind_and_allocmem
+
+
+
+ SUBROUTINE pmc_c_getbuffer( waittime )
+
+    IMPLICIT NONE
+
+    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
+
+    CHARACTER(LEN=da_namelen) ::  myname  !<
+
+    INTEGER                        ::  ierr     !<
+    INTEGER                        ::  ij       !<
+    INTEGER                        ::  ip       !<
+    INTEGER                        ::  j        !<
+    INTEGER                        ::  myindex  !<
+    INTEGER                        ::  nr       !< number of elements to get
+                                                !< from server
+    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp
+    INTEGER,DIMENSION(1)           ::  buf_shape
+
+    REAL(wp)                            ::  t1
+    REAL(wp)                            ::  t2
+
+    REAL(wp), POINTER, DIMENSION(:)     ::  buf
+    REAL(wp), POINTER, DIMENSION(:,:)   ::  data_2d
+    REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d
+    TYPE(pedef), POINTER                ::  ape
+    TYPE(arraydef), POINTER             ::  ar
+
+!
+!-- Synchronization of the model is done in pmci_client_synchronize and
+!-- pmci_server_synchronize. Therefor the RMA window can be filled without
+!-- sychronization at this point and a barrier is not necessary.
+!-- Please note that waittime has to be set in pmc_s_fillbuffer AND
+!-- pmc_c_getbuffer
+    IF ( PRESENT( waittime ) )  THEN
+       t1 = pmc_time()
+       CALL MPI_BARRIER( me%intra_comm, ierr )
+       t2 = pmc_time()
+       waittime = t2 - t1
+    ENDIF
+!
+!-- Wait for buffer is filled
+!-- TODO: explain in more detail what is happening here. The barrier seems to
+!-- contradict what is said a few lines beforer (i.e. that no barrier is necessary)
+!-- TODO: In case of PRESENT( waittime ) the barrrier would be calles twice. Why?
+!-- Shouldn't it be done the same way as in pmc_putbuffer?
+    CALL MPI_BARRIER( me%intra_comm, ierr )
+
+    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
+          ELSEIF ( ar%nrdims == 3 )  THEN
+             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
+!--       TODO: explain the above comment
+          IF ( nr > 0 )  THEN
+             target_disp = ar%recvindex - 1
+             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip-1, 0,                     &
+                                me%win_server_client, ierr )
+             CALL MPI_GET( buf, nr, MPI_REAL, ip-1, target_disp, nr, MPI_REAL, &
+                                me%win_server_client, ierr )
+             CALL MPI_WIN_UNLOCK( ip-1, me%win_server_client, 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) =                 &
+                                              buf(myindex:myindex+ar%a_dim(1)-1)
+                myindex = myindex+ar%a_dim(1)
+             ENDDO
+
+          ENDIF
+
+       ENDDO
+
+    ENDDO
+
+ END SUBROUTINE pmc_c_getbuffer
+
+
+
+ SUBROUTINE pmc_c_putbuffer( waittime )
+
+    IMPLICIT NONE
+
+    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
+
+    CHARACTER(LEN=da_namelen) ::  myname  !<
+
+    INTEGER                        ::  ierr         !<
+    INTEGER                        ::  ij           !<
+    INTEGER                        ::  ip           !<
+    INTEGER                        ::  j            !<
+    INTEGER                        ::  myindex      !<
+    INTEGER                        ::  nr           !< number of elements to get
+                                                    !< from server
+    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp  !<
+
+    INTEGER, DIMENSION(1)          ::  buf_shape    !<
+
+    REAL(wp) ::  t1  !<
+    REAL(wp) ::  t2  !<
+
+    REAL(wp), POINTER, DIMENSION(:)     ::  buf      !<
+    REAL(wp), POINTER, DIMENSION(:,:)   ::  data_2d  !<
+    REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
+
+    TYPE(pedef), POINTER               ::  ape  !<
+    TYPE(arraydef), POINTER            ::  ar   !<
+
+!
+!-- Wait for empty buffer
+!-- TODO: explain what is done here
+    t1 = pmc_time()
+    CALL MPI_BARRIER( me%intra_comm, ierr )
+    t2 = pmc_time()
+    IF ( PRESENT( waittime ) )  waittime = t2 - t1
+
+    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) =                           &
+                                    data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i)
+                myindex = myindex + ar%a_dim(1)
+             ENDDO
+
+          ENDIF
+
+       ENDDO
+
+    ENDDO
+!
+!-- TODO: Fence might do it, test later
+!-- Call MPI_WIN_FENCE( 0, me%win_server_client, ierr)      !
+!
+!-- Buffer is filled
+!-- TODO: explain in more detail what is happening here
+    CALL MPI_Barrier(me%intra_comm, ierr)
+
+ END SUBROUTINE pmc_c_putbuffer
 
 #endif
-END MODULE pmc_client
+ END MODULE pmc_client
