Ignore:
Timestamp:
Mar 3, 2016 8:01:28 AM (6 years ago)
Author:
raasch
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/pmc_client.f90

    r1765 r1779  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! kind=dp replaced by wp, dim_order removed
     23! array management changed from linked list to sequential loop
    2324!
    2425! Former revisions:
     
    5051    USE  kinds
    5152    USE  PMC_general,   ONLY: ClientDef, DA_NameDef, DA_Namelen, PMC_STATUS_OK, PMC_DA_NAME_ERR, PeDef, ArrayDef, &
    52                                          DA_Desclen, DA_Namelen, PMC_G_SetName, PMC_G_GetName
     53                                         DA_Desclen, DA_Namelen, PMC_G_SetName, PMC_MAX_ARRAY
    5354    USE  PMC_handle_communicator,   ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_server_comm
    5455    USE  PMC_MPI_wrapper,           ONLY: PMC_Send_to_Server, PMC_Recv_from_Server, PMC_Time,                     &
     
    5859    SAVE
    5960
    60 !   data local to this MODULE
    6161    Type(ClientDef)                       :: me
    62 !-- TO_DO: what is the meaning of this? Could variables declared in this module
    63 !--        also have single precision?
    64 !    INTEGER, PARAMETER                    :: dp = wp
    65 
    66     INTEGER, save                         :: myIndex = 0                !Counter and unique number for Data Arrays
     62
     63    INTEGER                               :: next_array_in_list = 0
     64    INTEGER                               :: myIndex = 0                !Counter and unique number for Data Arrays
    6765
    6866    ! INTERFACE section
     
    8179    END INTERFACE PMC_C_Get_2D_index_list
    8280
     81    INTERFACE PMC_C_clear_next_array_list
     82        MODULE procedure PMC_C_clear_next_array_list
     83    END INTERFACE PMC_C_clear_next_array_list
     84
    8385    INTERFACE PMC_C_GetNextArray
    8486        MODULE procedure PMC_C_GetNextArray
     
    105107
    106108    PUBLIC PMC_ClientInit , PMC_Set_DataArray_Name, PMC_C_Get_2D_index_list
    107     PUBLIC PMC_C_GetNextArray, PMC_C_Set_DataArray
    108     PUBLIC PMC_C_setInd_and_AllocMem , PMC_C_GetBuffer, PMC_C_PutBuffer ! ,PMC_C_GetServerType
     109    PUBLIC PMC_C_GetNextArray, PMC_C_Set_DataArray, PMC_C_clear_next_array_list
     110    PUBLIC PMC_C_setInd_and_AllocMem , PMC_C_GetBuffer, PMC_C_PutBuffer
    109111
    110112CONTAINS
     
    130132        CALL MPI_Intercomm_merge (me%inter_comm, .true., me%intra_comm, istat);
    131133        CALL MPI_Comm_rank (me%intra_comm, me%intra_rank, istat);
    132 
    133134        ALLOCATE (me%PEs(me%inter_npes))
    134135
     136!
     137!--     Allocate for all Server PEs an array of TYPE ArrayDef to store information of transfer array
    135138        do i=1,me%inter_npes
    136            NULLIFY(me%PEs(i)%Arrays)
     139           ALLOCATE(me%PEs(i)%array_list(PMC_MAX_ARRAY))
    137140        end do
    138141
     
    142145    END SUBROUTINE PMC_ClientInit
    143146
    144     SUBROUTINE PMC_Set_DataArray_Name (ServerArrayDesc, ServerArrayName, ClientArrayDesc, ClientArrayName, istat, LastEntry)
     147    SUBROUTINE PMC_Set_DataArray_Name (ServerArrayDesc, ServerArrayName, ClientArrayDesc, ClientArrayName, istat)
    145148        IMPLICIT none
    146149        character(len=*),INTENT(IN)           :: ServerArrayName
     
    149152        character(len=*),INTENT(IN)           :: ClientArrayDesc
    150153        INTEGER,INTENT(OUT)                   :: istat
    151         LOGICAL,INTENT(IN),optional           :: LastEntry
    152154
    153155        !-- local variables
     
    192194        CALL PMC_Bcast ( myName%NameOnClient, myPE, comm=m_to_server_comm)
    193195
    194         if(present (LastEntry))   then
    195             CALL PMC_Set_DataArray_Name_LastEntry ( LastEntry = LastEntry)
    196         end if
    197 
    198196        CALL PMC_G_SetName (me, myName%couple_index, myName%NameOnClient)
    199197
     
    231229       INTEGER(KIND=MPI_ADDRESS_KIND)          :: disp            !: Displacement Unit (Integer = 4, floating poit = 8
    232230       INTEGER,DIMENSION(me%inter_npes*2)      :: NrEle           !: Number of Elements of a horizontal slice
    233        TYPE(PeDef),POINTER                     :: aPE             !: Pointer to PeDef strzcture
     231       TYPE(PeDef),POINTER                     :: aPE             !: Pointer to PeDef structure
    234232       INTEGER(KIND=MPI_ADDRESS_KIND)          :: WinSize         !: Size of MPI window 2 (in bytes)
    235233       INTEGER,DIMENSION(:),POINTER            :: myInd
     
    299297    END SUBROUTINE PMC_C_Get_2D_index_list
    300298
     299    SUBROUTINE PMC_C_clear_next_array_list
     300       IMPLICIT none
     301
     302       next_array_in_list = 0
     303
     304       return
     305    END SUBROUTINE PMC_C_clear_next_array_list
     306
     307!   List handling is still required to get minimal interaction with pmc_interface
    301308    LOGICAL function PMC_C_GetNextArray (myName)
    302309        character(len=*),INTENT(OUT)               :: myName
    303310
    304311        !-- local variables
    305         INTEGER                      :: MyCoupleIndex
    306         LOGICAL                      :: MyLast                             !Last Array in List
    307         character(len=DA_Namelen)    :: loName
    308 
    309         loName = 'NoName '
    310         MyLast = .true.
    311 
    312         CALL PMC_G_GetName (me, MyCoupleIndex, loName, MyLast)
    313 
    314         myName = trim(loName)
    315 
    316         PMC_C_GetNextArray = .NOT. MyLast                        ! Return true if valid array
    317 
    318         return
     312       TYPE(PeDef),POINTER          :: aPE
     313       TYPE(ArrayDef),POINTER       :: ar
     314
     315       next_array_in_list = next_array_in_list+1
     316
     317!--    Array Names are the same on all client PE, so take first PE to get the name
     318       aPE => me%PEs(1)
     319
     320       if(next_array_in_list > aPE%Nr_arrays) then
     321          PMC_C_GetNextArray = .false.             !all arrays done
     322          return
     323       end if
     324
     325       ar  => aPE%array_list(next_array_in_list)
     326
     327       myName = ar%name
     328
     329       PMC_C_GetNextArray =  .true.                ! Return true if legal array
     330       return
    319331    END function PMC_C_GetNextArray
    320332
    321333    SUBROUTINE PMC_C_Set_DataArray_2d (array)
     334
    322335       IMPLICIT none
    323 !--    TO_DO: is double precision absolutely required here?
    324        REAL(kind=dp),INTENT(IN),DIMENSION(:,:)    :: array
    325        !-- local variables
    326        INTEGER                           :: NrDims
    327        INTEGER,DIMENSION (4)             :: dims
    328        INTEGER                           :: dim_order
    329        TYPE(c_ptr)                       :: array_adr
    330        INTEGER                           :: i
    331        TYPE(PeDef),POINTER               :: aPE
    332        TYPE(ArrayDef),POINTER            :: ar
     336
     337       REAL(wp), INTENT(IN) ,DIMENSION(:,:) ::  array
     338
     339       INTEGER                              :: NrDims
     340       INTEGER,DIMENSION (4)                :: dims
     341       TYPE(c_ptr)                          :: array_adr
     342       INTEGER                              :: i
     343       TYPE(PeDef),POINTER                  :: aPE
     344       TYPE(ArrayDef),POINTER               :: ar
    333345
    334346
     
    338350       dims(1)   = size(array,1)
    339351       dims(2)   = size(array,2)
    340        dim_order = 2
    341352
    342353       array_adr = c_loc(array)
     
    344355       do i=1,me%inter_npes
    345356          aPE => me%PEs(i)
    346           ar  => aPE%Arrays
     357          ar  => aPE%array_list(next_array_in_list)    !actual array is last array in list
    347358          ar%NrDims    = NrDims
    348359          ar%A_dim     = dims
    349           ar%dim_order = dim_order
    350360          ar%data      = array_adr
    351361       end do
     
    355365
    356366    SUBROUTINE PMC_C_Set_DataArray_3d (array)
     367
    357368       IMPLICIT none
    358 !--    TO_DO: is double precision absolutely required here?
    359        REAL(kind=dp),INTENT(IN),DIMENSION(:,:,:)  :: array
    360        !-- local variables
    361        INTEGER                           :: NrDims
    362        INTEGER,DIMENSION (4)             :: dims
    363        INTEGER                           :: dim_order
    364        TYPE(c_ptr)                       :: array_adr
    365        INTEGER                           :: i
    366        TYPE(PeDef),POINTER               :: aPE
    367        TYPE(ArrayDef),POINTER            :: ar
     369
     370       REAL(wp),INTENT(IN),DIMENSION(:,:,:) ::  array
     371
     372       INTEGER                              ::  NrDims
     373       INTEGER,DIMENSION (4)                ::  dims
     374       TYPE(c_ptr)                          ::  array_adr
     375       INTEGER                              ::  i
     376       TYPE(PeDef),POINTER                  ::  aPE
     377       TYPE(ArrayDef),POINTER               ::  ar
    368378
    369379       dims = 1
     
    373383       dims(2)   = size(array,2)
    374384       dims(3)   = size(array,3)
    375        dim_order =33
    376385
    377386       array_adr = c_loc(array)
     
    379388       do i=1,me%inter_npes
    380389          aPE => me%PEs(i)
    381           ar  => aPE%Arrays
     390          ar  => aPE%array_list(next_array_in_list)    !actual array is last array in list
    382391          ar%NrDims    = NrDims
    383392          ar%A_dim     = dims
    384           ar%dim_order = dim_order
    385393          ar%data      = array_adr
    386394       end do
     
    393401      IMPLICIT none
    394402
    395       INTEGER                                 :: i, ierr
     403      INTEGER                                 :: i, ierr, j
    396404      INTEGER                                 :: arlen, myIndex, tag
    397405      INTEGER(idp)                            :: bufsize                   ! Size of MPI data Window
     
    412420         tag = 200
    413421
    414          do while (PMC_C_GetNextArray (myName))
    415             ar  => aPE%Arrays
     422         do j=1,aPE%Nr_arrays
     423            ar  => aPE%array_list(j)
    416424
    417425            ! Receive Index from client
     
    419427            CALL MPI_Recv (myIndex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, MPI_STATUS_IGNORE, ierr)
    420428
    421             if(ar%dim_order == 33) then                    ! PALM has k in first dimension
     429            if(ar%NrDims == 3) then                    ! PALM has k in first dimension
    422430               bufsize = max(bufsize,ar%A_dim(1)*ar%A_dim(2)*ar%A_dim(3))    ! determine max, because client buffer is allocated only once
    423431            else
     
    442450         aPE => me%PEs(i)
    443451
    444          do while (PMC_C_GetNextArray (myName))
    445             ar  => aPE%Arrays
     452         do j=1,aPE%Nr_arrays
     453            ar  => aPE%array_list(j)
    446454            ar%SendBuf = base_ptr
    447455         end do
     
    452460
    453461   SUBROUTINE PMC_C_GetBuffer (WaitTime)
     462
    454463      IMPLICIT none
    455       REAL(kind=dp),INTENT(OUT),optional         :: WaitTime
     464
     465      REAL(wp), INTENT(OUT), optional   ::  WaitTime
    456466
    457467      !-- local variables
    458       INTEGER                                 :: ip, ij, ierr
    459       INTEGER                                 :: nr                 ! Number of Elements to getb from server
    460       INTEGER                                 :: myIndex
    461       REAL(kind=dp)                           :: t1,t2
    462       TYPE(PeDef),POINTER                     :: aPE
    463       TYPE(ArrayDef),POINTER                  :: ar
    464       INTEGER,DIMENSION(1)                    :: buf_shape
    465       REAL(kind=wp),POINTER,DIMENSION(:)      :: buf
    466       REAL(kind=wp),POINTER,DIMENSION(:,:)    :: data_2d
    467       REAL(kind=wp),POINTER,DIMENSION(:,:,:)  :: data_3d
    468       character(len=DA_Namelen)               :: myName
    469       INTEGER(kind=MPI_ADDRESS_KIND)          :: target_disp
     468      INTEGER                           ::  ip, ij, ierr, j
     469      INTEGER                           ::  nr  ! Number of Elements to getb from server
     470      INTEGER                           :: myIndex
     471      REAL(wp)                          :: t1,t2
     472      TYPE(PeDef),POINTER               :: aPE
     473      TYPE(ArrayDef),POINTER            :: ar
     474      INTEGER,DIMENSION(1)              :: buf_shape
     475      REAL(wp),POINTER,DIMENSION(:)     :: buf
     476      REAL(wp),POINTER,DIMENSION(:,:)   :: data_2d
     477      REAL(wp),POINTER,DIMENSION(:,:,:) :: data_3d
     478      character(len=DA_Namelen)         :: myName
     479      INTEGER(kind=MPI_ADDRESS_KIND)    :: target_disp
    470480
    471481      t1 = PMC_Time()
    472482      CALL MPI_Barrier(me%intra_comm, ierr)                         ! Wait for server to fill buffer
    473       t2 = PMC_Time()
    474       if(present(WaitTime)) WaitTime = t2-t1
     483      t2 = PMC_Time()-t1
     484      if(present(WaitTime)) WaitTime = t2
    475485
    476486      CALL MPI_Barrier(me%intra_comm, ierr)                         ! Wait for buffer is filled
     
    479489         aPE => me%PEs(ip)
    480490
    481          do while (PMC_C_GetNextArray (myName))
    482             ar  => aPE%Arrays
    483             if(ar%dim_order == 2) then
     491         do j=1,aPE%Nr_arrays
     492            ar  => aPE%array_list(j)
     493            if(ar%NrDims == 2) then
    484494               nr = aPE%NrEle
    485             else if(ar%dim_order == 33) then
     495            else if(ar%NrDims == 3) then
    486496               nr = aPE%NrEle*ar%A_dim(1)
    487497            end if
     
    489499            buf_shape(1) = nr
    490500            CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
    491 
     501!
     502!--         MPI passive target RMA
    492503            if(nr > 0)   then
    493504               target_disp = (ar%BufIndex-1)
     
    498509
    499510            myIndex = 1
    500             if(ar%dim_order == 2) then
     511            if(ar%NrDims == 2) then
    501512
    502513               CALL c_f_pointer(ar%data, data_2d, ar%A_dim(1:2))
     
    505516                  myIndex = myIndex+1
    506517               end do
    507             else if(ar%dim_order == 33) then
     518            else if(ar%NrDims == 3) then
    508519               CALL c_f_pointer(ar%data, data_3d, ar%A_dim(1:3))
    509520               do ij=1,aPE%NrEle
     
    519530
    520531   SUBROUTINE PMC_C_PutBuffer (WaitTime)
     532
    521533      IMPLICIT none
    522       REAL(kind=dp),INTENT(OUT),optional         :: WaitTime
     534
     535      REAL(wp), INTENT(OUT), optional   :: WaitTime
    523536
    524537      !-- local variables
    525       INTEGER                                 :: ip, ij, ierr
    526       INTEGER                                 :: nr                 ! Number of Elements to getb from server
    527       INTEGER                                 :: myIndex
    528       REAL(kind=dp)                           :: t1,t2
    529       TYPE(PeDef),POINTER                     :: aPE
    530       TYPE(ArrayDef),POINTER                  :: ar
    531       INTEGER,DIMENSION(1)                    :: buf_shape
    532       REAL(kind=wp),POINTER,DIMENSION(:)      :: buf
    533       REAL(kind=wp),POINTER,DIMENSION(:,:)    :: data_2d
    534       REAL(kind=wp),POINTER,DIMENSION(:,:,:)  :: data_3d
    535       character(len=DA_Namelen)               :: myName
    536       INTEGER(kind=MPI_ADDRESS_KIND)          :: target_disp
     538      INTEGER                           ::  ip, ij, ierr, j
     539      INTEGER                           ::  nr  ! Number of Elements to getb from server
     540      INTEGER                           :: myIndex
     541      REAL(wp)                          :: t1,t2
     542      TYPE(PeDef),POINTER               :: aPE
     543      TYPE(ArrayDef),POINTER            :: ar
     544      INTEGER,DIMENSION(1)              :: buf_shape
     545      REAL(wp),POINTER,DIMENSION(:)     :: buf
     546      REAL(wp),POINTER,DIMENSION(:,:)   :: data_2d
     547      REAL(wp),POINTER,DIMENSION(:,:,:) :: data_3d
     548      character(len=DA_Namelen)         :: myName
     549      INTEGER(kind=MPI_ADDRESS_KIND)    :: target_disp
    537550
    538551
     
    540553         aPE => me%PEs(ip)
    541554
    542          do while (PMC_C_GetNextArray (myName))
    543             ar  => aPE%Arrays
    544             if(ar%dim_order == 2) then
     555         do j=1,aPE%Nr_arrays
     556            ar  => aPE%array_list(j)
     557            if(ar%NrDims == 2) then
    545558               nr = aPE%NrEle
    546             else if(ar%dim_order == 33) then
     559            else if(ar%NrDims == 3) then
    547560               nr = aPE%NrEle*ar%A_dim(1)
    548561            end if
     
    552565
    553566            myIndex = 1
    554             if(ar%dim_order == 2) then
     567            if(ar%NrDims == 2) then
    555568               CALL c_f_pointer(ar%data, data_2d, ar%A_dim(1:2))
    556569               do ij=1,aPE%NrEle
     
    558571                  myIndex = myIndex+1
    559572               end do
    560             else if(ar%dim_order == 33) then
     573            else if(ar%NrDims == 3) then
    561574               CALL c_f_pointer(ar%data, data_3d, ar%A_dim(1:3))
    562575               do ij=1,aPE%NrEle
     
    565578               end do
    566579            end if
    567 
     580!
     581!--         MPI passiv target RMA
    568582            if(nr > 0)   then
    569583               target_disp = (ar%BufIndex-1)
Note: See TracChangeset for help on using the changeset viewer.