Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/pmc_server.f90

    r1767 r1779  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! kind=dp replaced by wp,
     23! error messages removed or changed to PALM style, dim_order removed
     24! array management changed from linked list to sequential loop
    2325!
    2426! Former revisions:
    … …  
    5254   USE  kinds
    5355   USE  PMC_general,               ONLY: ClientDef, PMC_MAX_MODELL,PMC_sort, DA_NameDef, DA_Desclen, DA_Namelen,       &
    54                                          PMC_G_SetName, PMC_G_GetName, PeDef, ArrayDef
     56                                         PMC_G_SetName, PeDef, ArrayDef, PMC_MAX_ARRAY
    5557   USE  PMC_handle_communicator,   ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_client_comm,                     &
    5658                                         PMC_Server_for_Client, m_world_rank
    … …  
    7072   TYPE(ClientIndexDef),DIMENSION(PMC_MAX_MODELL)     :: indClients
    7173
     74   INTEGER                                            :: next_array_in_list = 0
     75
    7276   PUBLIC PMC_Server_for_Client
    73 
    74 !-- TO_DO: what is the meaning of this? Could variables declared in this module
    75 !--        also have single precision?
    76 !   INTEGER, PARAMETER :: dp = wp
    77 
    78    ! INTERFACE section
    7977
    8078   INTERFACE PMC_ServerInit
    … …  
    8583        MODULE procedure PMC_S_Set_2D_index_list
    8684    END INTERFACE PMC_S_Set_2D_index_list
     85
     86    INTERFACE PMC_S_clear_next_array_list
     87        MODULE procedure PMC_S_clear_next_array_list
     88    END INTERFACE PMC_S_clear_next_array_list
    8789
    8890    INTERFACE PMC_S_GetNextArray
    … …  
    115117    PUBLIC PMC_ServerInit, PMC_S_Set_2D_index_list, PMC_S_GetNextArray, PMC_S_Set_DataArray
    116118    PUBLIC PMC_S_setInd_and_AllocMem, PMC_S_FillBuffer, PMC_S_GetData_from_Buffer, PMC_S_Set_Active_data_array
     119    PUBLIC PMC_S_clear_next_array_list
    117120
    118121CONTAINS
    … …  
    145148
    146149         ALLOCATE (Clients(ClientId)%PEs(Clients(ClientId)%inter_npes))
    147 
    148          do j=1,Clients(ClientId)%inter_npes                                ! Loop over all client PEs
    149            NULLIFY(Clients(ClientId)%PEs(j)%Arrays)
     150!
     151!--      Allocate for all client PEs an array of TYPE ArrayDef to store information of transfer array
     152         do j=1,Clients(ClientId)%inter_npes
     153           Allocate(Clients(ClientId)%PEs(j)%array_list(PMC_MAX_ARRAY))
    150154         end do
    151155
    … …  
    219223    END SUBROUTINE PMC_S_Set_2D_index_list
    220224
    221     logical function PMC_S_GetNextArray (ClientId, myName,Client_PeIndex)
     225    SUBROUTINE PMC_S_clear_next_array_list
     226       IMPLICIT none
     227
     228       next_array_in_list = 0
     229
     230       return
     231    END SUBROUTINE PMC_S_clear_next_array_list
     232
     233!   List handling is still required to get minimal interaction with pmc_interface
     234    logical function PMC_S_GetNextArray (ClientId, myName)
     235       INTEGER(iwp),INTENT(IN)                    :: ClientId
     236       CHARACTER(len=*),INTENT(OUT)               :: myName
     237
     238!--    local variables
     239       TYPE(PeDef),POINTER          :: aPE
     240       TYPE(ArrayDef),POINTER       :: ar
     241
     242       next_array_in_list = next_array_in_list+1
     243
     244!--    Array Names are the same on all client PE, so take first PE to get the name
     245       aPE => Clients(ClientId)%PEs(1)
     246
     247       if(next_array_in_list > aPE%Nr_arrays) then
     248          PMC_S_GetNextArray = .false.              ! all arrays done
     249          return
     250       end if
     251
     252       ar  => aPE%array_list(next_array_in_list)
     253       myName = ar%name
     254
     255       PMC_S_GetNextArray =  .true.                 ! Return true if legal array
     256       return
     257    END function PMC_S_GetNextArray
     258
     259    SUBROUTINE PMC_S_Set_DataArray_2d (ClientId, array, array_2 )
     260
     261        IMPLICIT none
     262
    222263        INTEGER,INTENT(IN)                         :: ClientId
    223         CHARACTER(len=*),INTENT(OUT)               :: myName
    224 
    225         !-- local variables
    226         INTEGER                      :: MyCoupleIndex
    227         logical                      :: MyLast
    228         CHARACTER(len=DA_Namelen)    :: loName
    229         INTEGER,INTENT(IN),optional  :: Client_PeIndex
    230 
    231         loName = ' '
    232 
    233         CALL PMC_G_GetName (clients(ClientId), MyCoupleIndex, loName, MyLast, Client_PeIndex)
    234 
    235         myName    = loName
    236 
    237         PMC_S_GetNextArray = .NOT. MyLast                   ! Return true if valid array
    238 
    239         return
    240     END function PMC_S_GetNextArray
    241 
    242     SUBROUTINE PMC_S_Set_DataArray_2d (ClientId, array, array_2 )
    243         IMPLICIT none
    244         INTEGER,INTENT(IN)                         :: ClientId
    245 !--   TO_DO: has array always to be of dp-kind, or can wp used here
    246 !--          this effects all respective declarations in this file
    247         REAL(kind=dp),INTENT(IN),DIMENSION(:,:)           :: array
    248         REAL(kind=dp),INTENT(IN),DIMENSION(:,:),OPTIONAL  :: array_2
    249         !-- local variables
     264        REAL(wp), INTENT(IN), DIMENSION(:,:)           ::  array
     265        REAL(wp), INTENT(IN), DIMENSION(:,:), OPTIONAL ::  array_2
     266
    250267        INTEGER                           :: NrDims
    251268        INTEGER,DIMENSION (4)             :: dims
    252         INTEGER                           :: dim_order
    253269        TYPE(c_ptr)                       :: array_adr
    254270        TYPE(c_ptr)                       :: second_adr
    … …  
    259275        dims(1)   = size(array,1)
    260276        dims(2)   = size(array,2)
    261         dim_order = 2
    262 
    263277        array_adr = c_loc(array)
    264278
    265279        IF ( PRESENT( array_2 ) )  THEN
    266280           second_adr = c_loc(array_2)
    267            CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr, second_adr = second_adr)
     281           CALL PMC_S_SetArray (ClientId, NrDims, dims, array_adr, second_adr = second_adr)
    268282        ELSE
    269            CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
     283           CALL PMC_S_SetArray (ClientId, NrDims, dims, array_adr)
    270284        ENDIF
    271285
    … …  
    274288
    275289    SUBROUTINE PMC_S_Set_DataArray_3d (ClientId, array, nz_cl, nz, array_2 )
     290
    276291        IMPLICIT none
     292
    277293        INTEGER,INTENT(IN)                         :: ClientId
    278         REAL(kind=dp),INTENT(IN),DIMENSION(:,:,:)  :: array
    279         REAL(kind=dp),INTENT(IN),DIMENSION(:,:,:),OPTIONAL  :: array_2
     294        REAL(wp), INTENT(IN), DIMENSION(:,:,:)           :: array
     295        REAL(wp), INTENT(IN), DIMENSION(:,:,:), OPTIONAL :: array_2
    280296        INTEGER,INTENT(IN)                         :: nz_cl
    281297        INTEGER,INTENT(IN)                         :: nz
    282         !-- local variables
     298
    283299        INTEGER                           :: NrDims
    284300        INTEGER,DIMENSION (4)             :: dims
    285         INTEGER                           :: dim_order
    286301        TYPE(c_ptr)                       :: array_adr
    287302        TYPE(c_ptr)                       :: second_adr
    … …  
    294309        dims(2)   = size(array,2)
    295310        dims(3)   = size(array,3)
    296         dim_order = 33
    297311        dims(4)   = nz_cl+dims(1)-nz                        ! works for first dimension 1:nz and 0:nz+1
    298312
    … …  
    304318        IF ( PRESENT( array_2 ) )  THEN
    305319          second_adr = c_loc(array_2)
    306           CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr, second_adr = second_adr)
     320          CALL PMC_S_SetArray (ClientId, NrDims, dims, array_adr, second_adr = second_adr)
    307321        ELSE
    308            CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
     322           CALL PMC_S_SetArray (ClientId, NrDims, dims, array_adr)
    309323        ENDIF
    310324
    … …  
    313327
    314328   SUBROUTINE PMC_S_setInd_and_AllocMem (ClientId)
     329
     330      USE control_parameters,                                                  &
     331          ONLY:  message_string
     332
    315333      IMPLICIT none
     334
    316335      INTEGER,INTENT(IN)                      :: ClientId
    317336
    318       INTEGER                                 :: i, istat, ierr
     337      INTEGER                                 :: i, istat, ierr, j
    319338      INTEGER                                 :: arlen, myIndex, tag
    320339      INTEGER                                 :: rCount                    ! count MPI requests
    … …  
    337356         aPE => Clients(ClientId)%PEs(i)
    338357         tag = 200
    339          do while (PMC_S_GetNextArray ( ClientId, myName,i))
    340             ar  => aPE%Arrays
    341             if(ar%dim_order == 2) then
     358         do j=1,aPE%Nr_arrays
     359            ar  => aPE%array_list(j)
     360            if(ar%NrDims == 2) then
    342361               arlen     = aPE%NrEle;                             ! 2D
    343             else if(ar%dim_order == 33) then
     362            else if(ar%NrDims == 3) then
    344363               arlen     = aPE%NrEle * ar%A_dim(4);               ! PALM 3D
    345364            else
    … …  
    382401      do i=1,Clients(ClientId)%inter_npes
    383402         aPE => Clients(ClientId)%PEs(i)
    384          do while (PMC_S_GetNextArray ( ClientId, myName,i))
    385             ar  => aPE%Arrays
     403         do j=1,aPE%Nr_arrays
     404            ar  => aPE%array_list(j)
    386405!--         TO_DO:  Adressrechnung ueberlegen?
    387406            ar%SendBuf = c_loc(base_array(ar%BufIndex))                         !kk Adressrechnung ueberlegen
    388407            if(ar%BufIndex+ar%BufSize > bufsize) then
    389408!--            TO_DO: can this error really happen, and what can be the reason?
    390                write(0,'(a,i4,4i7,1x,a)') 'Buffer too small ',i,ar%BufIndex,ar%BufSize,ar%BufIndex+ar%BufSize,bufsize,trim(myName)
     409               write(0,'(a,i4,4i7,1x,a)') 'Buffer too small ',i,ar%BufIndex,ar%BufSize,ar%BufIndex+ar%BufSize,bufsize,trim(ar%name)
    391410               CALL MPI_Abort (MPI_COMM_WORLD, istat, ierr)
    392411            end if
    … …  
    399418   SUBROUTINE PMC_S_FillBuffer (ClientId, WaitTime)
    400419      IMPLICIT none
    401       INTEGER,INTENT(IN)                      :: ClientId
    402       REAL(kind=dp),INTENT(OUT),optional      :: WaitTime
    403 
    404       !-- local variables
    405       INTEGER                                 :: ip,ij,istat,ierr
    406       INTEGER                                 :: myIndex
    407       REAL(kind=dp)                           :: t1,t2
    408       TYPE(PeDef),POINTER                     :: aPE
    409       TYPE(ArrayDef),POINTER                  :: ar
    410       CHARACTER(len=DA_Namelen)               :: myName
    411       INTEGER,DIMENSION(1)                    :: buf_shape
    412       REAL(kind=wp),POINTER,DIMENSION(:)      :: buf
    413       REAL(kind=wp),POINTER,DIMENSION(:,:)    :: data_2d
    414       REAL(kind=wp),POINTER,DIMENSION(:,:,:)  :: data_3d
     420      INTEGER,INTENT(IN)                  ::  ClientId
     421      REAL(wp), INTENT(OUT), OPTIONAL     ::  WaitTime
     422
     423      INTEGER                             ::  ip,ij,istat,ierr,j
     424      INTEGER                             ::  myIndex
     425      REAL(wp)                            ::  t1,t2
     426      TYPE(PeDef),POINTER                 ::  aPE
     427      TYPE(ArrayDef),POINTER              ::  ar
     428      CHARACTER(len=DA_Namelen)           ::  myName
     429      INTEGER,DIMENSION(1)                ::  buf_shape
     430      REAL(wp), POINTER, DIMENSION(:)     ::  buf
     431      REAL(wp), POINTER, DIMENSION(:,:)   ::  data_2d
     432      REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d
    415433
    416434      t1 = PMC_Time()
    … …  
    421439      do ip=1,Clients(ClientId)%inter_npes
    422440         aPE => Clients(ClientId)%PEs(ip)
    423          do while (PMC_S_GetNextArray ( ClientId, myName,ip))
    424             ar  => aPE%Arrays
     441         do j=1,aPE%Nr_arrays
     442            ar  => aPE%array_list(j)
    425443            myIndex=1
    426             if(ar%dim_order == 2) then
     444            if(ar%NrDims == 2) then
    427445               buf_shape(1) = aPE%NrEle
    428446               CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
    … …  
    432450                  myIndex = myIndex+1
    433451               end do
    434             else if(ar%dim_order == 33) then
     452            else if(ar%NrDims == 3) then
    435453               buf_shape(1) = aPE%NrEle*ar%A_dim(4)
    436454               CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
    … …  
    440458                  myIndex = myIndex+ar%A_dim(4)
    441459               end do
    442             else
    443 !--            TO_DO: can this error really happen, and what can be the reason?
    444                write(0,*) "Illegal Order of Dimension ",ar%dim_order
    445                CALL MPI_Abort (MPI_COMM_WORLD, istat, ierr);
    446 
    447460            end if
    448461          end do
    449462      end do
    450463
    451       CALL MPI_Barrier(Clients(ClientId)%intra_comm, ierr)              ! buffer is full
     464      CALL MPI_Barrier(Clients(ClientId)%intra_comm, ierr)    ! buffer is full
    452465
    453466      return
    … …  
    455468
    456469   SUBROUTINE PMC_S_GetData_from_Buffer (ClientId, WaitTime)
     470
    457471      IMPLICIT none
    458       INTEGER,INTENT(IN)                      :: ClientId
    459       REAL(kind=dp),INTENT(OUT),optional      :: WaitTime
     472
     473      INTEGER,INTENT(IN)                  ::  ClientId
     474      REAL(wp), INTENT(OUT), OPTIONAL     ::  WaitTime
    460475
    461476      !-- local variables
    462       INTEGER                                 :: ip,ij,istat,ierr
    463       INTEGER                                 :: myIndex
    464       REAL(kind=dp)                           :: t1,t2
    465       TYPE(PeDef),POINTER                     :: aPE
    466       TYPE(ArrayDef),POINTER                  :: ar
    467       CHARACTER(len=DA_Namelen)               :: myName
    468       INTEGER,DIMENSION(1)                    :: buf_shape
    469       REAL(kind=wp),POINTER,DIMENSION(:)      :: buf
    470       REAL(kind=wp),POINTER,DIMENSION(:,:)    :: data_2d
    471       REAL(kind=wp),POINTER,DIMENSION(:,:,:)  :: data_3d
     477      INTEGER                             ::  ip,ij,istat,ierr,j
     478      INTEGER                             :: myIndex
     479      REAL(wp)                            :: t1,t2
     480      TYPE(PeDef),POINTER                 :: aPE
     481      TYPE(ArrayDef),POINTER              :: ar
     482      CHARACTER(len=DA_Namelen)           :: myName
     483      INTEGER,DIMENSION(1)                :: buf_shape
     484      REAL(wp), POINTER, DIMENSION(:)     :: buf
     485      REAL(wp), POINTER, DIMENSION(:,:)   :: data_2d
     486      REAL(wp), POINTER, DIMENSION(:,:,:) :: data_3d
    472487
    473488      t1 = PMC_Time()
    … …  
    478493      do ip=1,Clients(ClientId)%inter_npes
    479494         aPE => Clients(ClientId)%PEs(ip)
    480          do while (PMC_S_GetNextArray ( ClientId, myName,ip))
    481             ar  => aPE%Arrays
     495         do j=1,aPE%Nr_arrays
     496            ar  => aPE%array_list(j)
    482497            myIndex=1
    483             if(ar%dim_order == 2) then
     498            if(ar%NrDims == 2) then
    484499               buf_shape(1) = aPE%NrEle
    485500               CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
    … …  
    489504                  myIndex = myIndex+1
    490505               end do
    491             else if(ar%dim_order == 33) then
     506            else if(ar%NrDims == 3) then
    492507               buf_shape(1) = aPE%NrEle*ar%A_dim(4)
    493508               CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
    … …  
    497512                  myIndex = myIndex+ar%A_dim(4)
    498513               end do
    499             else
    500 !--            TO_DO: can this error really happen, and what can be the reason?
    501                write(0,*) "Illegal Order of Dimension ",ar%dim_order
    502                CALL MPI_Abort (MPI_COMM_WORLD, istat, ierr);
    503 
    504514            end if
    505515          end do
    … …  
    535545   END SUBROUTINE Get_DA_names_from_client
    536546
    537    SUBROUTINE PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr, second_adr)
     547   SUBROUTINE PMC_S_SetArray (ClientId, NrDims, dims, array_adr, second_adr)
    538548      IMPLICIT none
    539549
    … …  
    541551      INTEGER,INTENT(IN)                      :: NrDims
    542552      INTEGER,INTENT(IN),DIMENSION(:)         :: dims
    543       INTEGER,INTENT(IN)                      :: dim_order
    544553      TYPE(c_ptr),INTENT(IN)                  :: array_adr
    545554      TYPE(c_ptr),INTENT(IN),OPTIONAL         :: second_adr
    … …  
    554563       do i=1,Clients(ClientId)%inter_npes
    555564          aPE => Clients(ClientId)%PEs(i)
    556           ar  => aPE%Arrays
     565          ar  => aPE%array_list(next_array_in_list)
    557566          ar%NrDims    = NrDims
    558567          ar%A_dim     = dims
    559           ar%dim_order = dim_order
    560568          ar%data      = array_adr
    561569          if(present(second_adr)) then
    … …  
    579587
    580588!--   local variables
    581       INTEGER                                 :: i, ip
     589      INTEGER                                 :: i, ip, j
    582590      TYPE(PeDef),POINTER                     :: aPE
    583591      TYPE(ArrayDef),POINTER                  :: ar
    … …  
    586594      do ip=1,Clients(ClientId)%inter_npes
    587595         aPE => Clients(ClientId)%PEs(ip)
    588          do while (PMC_S_GetNextArray ( ClientId, myName,ip))
    589             ar  => aPE%Arrays
     596         do j=1,aPE%Nr_arrays
     597            ar  => aPE%array_list(j)
    590598            if(iactive == 1 .OR. iactive == 2)   then
    591599               ar%data = ar%po_data(iactive)
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |