Changeset 1779 for palm/trunk/SOURCE/pmc_client.f90

Timestamp:

Mar 3, 2016 8:01:28 AM (8 years ago)

Author:

raasch

Message:

pmc array management changed from linked list to sequential loop; further small changes and cosmetics for the pmc

File:

• palm/trunk/SOURCE/pmc_client.f90 (modified) (30 diffs)

palm/trunk/SOURCE/pmc_client.f90

@@ -20 +20 @@
 ! Current revisions:
 ! ------------------
-!
+! kind=dp replaced by wp, dim_order removed
+! array management changed from linked list to sequential loop
 !
 ! Former revisions:
@@ -50 +51 @@
     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_G_GetName
+                                         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,                     &
@@ -58 +59 @@
     SAVE
 
-!   data local to this MODULE
     Type(ClientDef)                       :: me
-!-- TO_DO: what is the meaning of this? Could variables declared in this module
-!--        also have single precision?
-!    INTEGER, PARAMETER                    :: dp = wp
-
-    INTEGER, save                         :: myIndex = 0                !Counter and unique number for Data Arrays
+
+    INTEGER                               :: next_array_in_list = 0
+    INTEGER                               :: myIndex = 0                !Counter and unique number for Data Arrays
 
     ! INTERFACE section
@@ -81 +79 @@
     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
@@ -105 +107 @@
 
     PUBLIC PMC_ClientInit , PMC_Set_DataArray_Name, PMC_C_Get_2D_index_list
-    PUBLIC PMC_C_GetNextArray, PMC_C_Set_DataArray
-    PUBLIC PMC_C_setInd_and_AllocMem , PMC_C_GetBuffer, PMC_C_PutBuffer ! ,PMC_C_GetServerType
+    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
@@ -130 +132 @@
         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
-           NULLIFY(me%PEs(i)%Arrays)
+           ALLOCATE(me%PEs(i)%array_list(PMC_MAX_ARRAY))
         end do
 
@@ -142 +145 @@
     END SUBROUTINE PMC_ClientInit
 
-    SUBROUTINE PMC_Set_DataArray_Name (ServerArrayDesc, ServerArrayName, ClientArrayDesc, ClientArrayName, istat, LastEntry)
+    SUBROUTINE PMC_Set_DataArray_Name (ServerArrayDesc, ServerArrayName, ClientArrayDesc, ClientArrayName, istat)
         IMPLICIT none
         character(len=*),INTENT(IN)           :: ServerArrayName
@@ -149 +152 @@
         character(len=*),INTENT(IN)           :: ClientArrayDesc
         INTEGER,INTENT(OUT)                   :: istat
-        LOGICAL,INTENT(IN),optional           :: LastEntry
 
         !-- local variables
@@ -192 +194 @@
         CALL PMC_Bcast ( myName%NameOnClient, myPE, comm=m_to_server_comm)
 
-        if(present (LastEntry))   then
-            CALL PMC_Set_DataArray_Name_LastEntry ( LastEntry = LastEntry)
-        end if
-
         CALL PMC_G_SetName (me, myName%couple_index, myName%NameOnClient)
 
@@ -231 +229 @@
        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 strzcture
+       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
@@ -299 +297 @@
     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
-        INTEGER                      :: MyCoupleIndex
-        LOGICAL                      :: MyLast                             !Last Array in List
-        character(len=DA_Namelen)    :: loName
-
-        loName = 'NoName '
-        MyLast = .true.
-
-        CALL PMC_G_GetName (me, MyCoupleIndex, loName, MyLast)
-
-        myName = trim(loName)
-
-        PMC_C_GetNextArray = .NOT. MyLast                        ! Return true if valid array
-
-        return
+       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
-!--    TO_DO: is double precision absolutely required here?
-       REAL(kind=dp),INTENT(IN),DIMENSION(:,:)    :: array
-       !-- local variables
-       INTEGER                           :: NrDims
-       INTEGER,DIMENSION (4)             :: dims
-       INTEGER                           :: dim_order
-       TYPE(c_ptr)                       :: array_adr
-       INTEGER                           :: i
-       TYPE(PeDef),POINTER               :: aPE
-       TYPE(ArrayDef),POINTER            :: ar
+
+       REAL(wp), INTENT(IN) ,DIMENSION(:,:) ::  array
+
+       INTEGER                              :: NrDims
+       INTEGER,DIMENSION (4)                :: dims
+       TYPE(c_ptr)                          :: array_adr
+       INTEGER                              :: i
+       TYPE(PeDef),POINTER                  :: aPE
+       TYPE(ArrayDef),POINTER               :: ar
 
 
@@ -338 +350 @@
        dims(1)   = size(array,1)
        dims(2)   = size(array,2)
-       dim_order = 2
 
        array_adr = c_loc(array)
@@ -344 +355 @@
        do i=1,me%inter_npes
           aPE => me%PEs(i)
-          ar  => aPE%Arrays
+          ar  => aPE%array_list(next_array_in_list)    !actual array is last array in list
           ar%NrDims    = NrDims
           ar%A_dim     = dims
-          ar%dim_order = dim_order
           ar%data      = array_adr
        end do
@@ -355 +365 @@
 
     SUBROUTINE PMC_C_Set_DataArray_3d (array)
+
        IMPLICIT none
-!--    TO_DO: is double precision absolutely required here?
-       REAL(kind=dp),INTENT(IN),DIMENSION(:,:,:)  :: array
-       !-- local variables
-       INTEGER                           :: NrDims
-       INTEGER,DIMENSION (4)             :: dims
-       INTEGER                           :: dim_order
-       TYPE(c_ptr)                       :: array_adr
-       INTEGER                           :: i
-       TYPE(PeDef),POINTER               :: aPE
-       TYPE(ArrayDef),POINTER            :: ar
+
+       REAL(wp),INTENT(IN),DIMENSION(:,:,:) ::  array
+
+       INTEGER                              ::  NrDims
+       INTEGER,DIMENSION (4)                ::  dims
+       TYPE(c_ptr)                          ::  array_adr
+       INTEGER                              ::  i
+       TYPE(PeDef),POINTER                  ::  aPE
+       TYPE(ArrayDef),POINTER               ::  ar
 
        dims = 1
@@ -373 +383 @@
        dims(2)   = size(array,2)
        dims(3)   = size(array,3)
-       dim_order =33
 
        array_adr = c_loc(array)
@@ -379 +388 @@
        do i=1,me%inter_npes
           aPE => me%PEs(i)
-          ar  => aPE%Arrays
+          ar  => aPE%array_list(next_array_in_list)    !actual array is last array in list
           ar%NrDims    = NrDims
           ar%A_dim     = dims
-          ar%dim_order = dim_order
           ar%data      = array_adr
        end do
@@ -393 +401 @@
       IMPLICIT none
 
-      INTEGER                                 :: i, ierr
+      INTEGER                                 :: i, ierr, j
       INTEGER                                 :: arlen, myIndex, tag
       INTEGER(idp)                            :: bufsize                   ! Size of MPI data Window
@@ -412 +420 @@
          tag = 200
 
-         do while (PMC_C_GetNextArray (myName))
-            ar  => aPE%Arrays
+         do j=1,aPE%Nr_arrays
+            ar  => aPE%array_list(j)
 
             ! Receive Index from client
@@ -419 +427 @@
             CALL MPI_Recv (myIndex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, MPI_STATUS_IGNORE, ierr)
 
-            if(ar%dim_order == 33) then                    ! PALM has k in first dimension
+            if(ar%NrDims == 3) then                    ! PALM has k in first dimension
                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
@@ -442 +450 @@
          aPE => me%PEs(i)
 
-         do while (PMC_C_GetNextArray (myName))
-            ar  => aPE%Arrays
+         do j=1,aPE%Nr_arrays
+            ar  => aPE%array_list(j)
             ar%SendBuf = base_ptr
          end do
@@ -452 +460 @@
 
    SUBROUTINE PMC_C_GetBuffer (WaitTime)
+
       IMPLICIT none
-      REAL(kind=dp),INTENT(OUT),optional         :: WaitTime
+
+      REAL(wp), INTENT(OUT), optional   ::  WaitTime
 
       !-- local variables
-      INTEGER                                 :: ip, ij, ierr
-      INTEGER                                 :: nr                 ! Number of Elements to getb from server
-      INTEGER                                 :: myIndex
-      REAL(kind=dp)                           :: t1,t2
-      TYPE(PeDef),POINTER                     :: aPE
-      TYPE(ArrayDef),POINTER                  :: ar
-      INTEGER,DIMENSION(1)                    :: buf_shape
-      REAL(kind=wp),POINTER,DIMENSION(:)      :: buf
-      REAL(kind=wp),POINTER,DIMENSION(:,:)    :: data_2d
-      REAL(kind=wp),POINTER,DIMENSION(:,:,:)  :: data_3d
-      character(len=DA_Namelen)               :: myName
-      INTEGER(kind=MPI_ADDRESS_KIND)          :: target_disp
+      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 server to fill buffer
-      t2 = PMC_Time()
-      if(present(WaitTime)) WaitTime = t2-t1
+      t2 = PMC_Time()-t1
+      if(present(WaitTime)) WaitTime = t2
 
       CALL MPI_Barrier(me%intra_comm, ierr)                         ! Wait for buffer is filled
@@ -479 +489 @@
          aPE => me%PEs(ip)
 
-         do while (PMC_C_GetNextArray (myName))
-            ar  => aPE%Arrays
-            if(ar%dim_order == 2) then
+         do j=1,aPE%Nr_arrays
+            ar  => aPE%array_list(j)
+            if(ar%NrDims == 2) then
                nr = aPE%NrEle
-            else if(ar%dim_order == 33) then
+            else if(ar%NrDims == 3) then
                nr = aPE%NrEle*ar%A_dim(1)
             end if
@@ -489 +499 @@
             buf_shape(1) = nr
             CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
-
+!
+!--         MPI passive target RMA
             if(nr > 0)   then
                target_disp = (ar%BufIndex-1)
@@ -498 +509 @@
 
             myIndex = 1
-            if(ar%dim_order == 2) then
+            if(ar%NrDims == 2) then
 
                CALL c_f_pointer(ar%data, data_2d, ar%A_dim(1:2))
@@ -505 +516 @@
                   myIndex = myIndex+1
                end do
-            else if(ar%dim_order == 33) then
+            else if(ar%NrDims == 3) then
                CALL c_f_pointer(ar%data, data_3d, ar%A_dim(1:3))
                do ij=1,aPE%NrEle
@@ -519 +530 @@
 
    SUBROUTINE PMC_C_PutBuffer (WaitTime)
+
       IMPLICIT none
-      REAL(kind=dp),INTENT(OUT),optional         :: WaitTime
+
+      REAL(wp), INTENT(OUT), optional   :: WaitTime
 
       !-- local variables
-      INTEGER                                 :: ip, ij, ierr
-      INTEGER                                 :: nr                 ! Number of Elements to getb from server
-      INTEGER                                 :: myIndex
-      REAL(kind=dp)                           :: t1,t2
-      TYPE(PeDef),POINTER                     :: aPE
-      TYPE(ArrayDef),POINTER                  :: ar
-      INTEGER,DIMENSION(1)                    :: buf_shape
-      REAL(kind=wp),POINTER,DIMENSION(:)      :: buf
-      REAL(kind=wp),POINTER,DIMENSION(:,:)    :: data_2d
-      REAL(kind=wp),POINTER,DIMENSION(:,:,:)  :: data_3d
-      character(len=DA_Namelen)               :: myName
-      INTEGER(kind=MPI_ADDRESS_KIND)          :: target_disp
+      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
 
 
@@ -540 +553 @@
          aPE => me%PEs(ip)
 
-         do while (PMC_C_GetNextArray (myName))
-            ar  => aPE%Arrays
-            if(ar%dim_order == 2) then
+         do j=1,aPE%Nr_arrays
+            ar  => aPE%array_list(j)
+            if(ar%NrDims == 2) then
                nr = aPE%NrEle
-            else if(ar%dim_order == 33) then
+            else if(ar%NrDims == 3) then
                nr = aPE%NrEle*ar%A_dim(1)
             end if
@@ -552 +565 @@
 
             myIndex = 1
-            if(ar%dim_order == 2) then
+            if(ar%NrDims == 2) then
                CALL c_f_pointer(ar%data, data_2d, ar%A_dim(1:2))
                do ij=1,aPE%NrEle
@@ -558 +571 @@
                   myIndex = myIndex+1
                end do
-            else if(ar%dim_order == 33) then
+            else if(ar%NrDims == 3) then
                CALL c_f_pointer(ar%data, data_3d, ar%A_dim(1:3))
                do ij=1,aPE%NrEle
@@ -565 +578 @@
                end do
             end if
-
+!
+!--         MPI passiv target RMA
             if(nr > 0)   then
                target_disp = (ar%BufIndex-1)