Ignore:
Timestamp:
Feb 29, 2016 8:37:15 AM (6 years ago)
Author:
raasch
Message:

pmc now runs with pointer version too

File:
1 edited

Legend:

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

    r1765 r1766  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! modifications to allow for using PALM's pointer version
     23! +new routine PMC_S_Set_Active_data_array
    2324!
    2425! Former revisions:
     
    103104    END INTERFACE PMC_S_GetData_from_Buffer
    104105
     106    INTERFACE PMC_S_Set_Active_data_array
     107        MODULE procedure PMC_S_Set_Active_data_array
     108    END INTERFACE PMC_S_Set_Active_data_array
     109
    105110    ! PUBLIC section
    106111
    107112    PUBLIC PMC_ServerInit, PMC_S_Set_2D_index_list, PMC_S_GetNextArray, PMC_S_Set_DataArray
    108     PUBLIC PMC_S_setInd_and_AllocMem, PMC_S_FillBuffer, PMC_S_GetData_from_Buffer
     113    PUBLIC PMC_S_setInd_and_AllocMem, PMC_S_FillBuffer, PMC_S_GetData_from_Buffer, PMC_S_Set_Active_data_array
    109114
    110115CONTAINS
     
    232237    END function PMC_S_GetNextArray
    233238
    234     SUBROUTINE PMC_S_Set_DataArray_2d (ClientId, array)
     239    SUBROUTINE PMC_S_Set_DataArray_2d (ClientId, array, array_2 )
    235240        IMPLICIT none
    236241        INTEGER,INTENT(IN)                         :: ClientId
    237242!--   TO_DO: has array always to be of dp-kind, or can wp used here
    238243!--          this effects all respective declarations in this file
    239         REAL(kind=dp),INTENT(IN),DIMENSION(:,:)    :: array
     244        REAL(kind=dp),INTENT(IN),DIMENSION(:,:)           :: array
     245        REAL(kind=dp),INTENT(IN),DIMENSION(:,:),OPTIONAL  :: array_2
    240246        !-- local variables
    241247        INTEGER                           :: NrDims
     
    243249        INTEGER                           :: dim_order
    244250        TYPE(c_ptr)                       :: array_adr
     251        TYPE(c_ptr)                       :: second_adr
    245252
    246253        dims = 1
     
    253260        array_adr = c_loc(array)
    254261
    255         CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
     262        IF ( PRESENT( array_2 ) )  THEN
     263           second_adr = c_loc(array_2)
     264           CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr, second_adr = second_adr)
     265        ELSE
     266           CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
     267        ENDIF
    256268
    257269        return
    258270    END SUBROUTINE PMC_S_Set_DataArray_2d
    259271
    260     SUBROUTINE PMC_S_Set_DataArray_3d (ClientId, array, nz_cl, nz)
     272    SUBROUTINE PMC_S_Set_DataArray_3d (ClientId, array, nz_cl, nz, array_2 )
    261273        IMPLICIT none
    262274        INTEGER,INTENT(IN)                         :: ClientId
    263275        REAL(kind=dp),INTENT(IN),DIMENSION(:,:,:)  :: array
     276        REAL(kind=dp),INTENT(IN),DIMENSION(:,:,:),OPTIONAL  :: array_2
    264277        INTEGER,INTENT(IN)                         :: nz_cl
    265278        INTEGER,INTENT(IN)                         :: nz
     
    269282        INTEGER                           :: dim_order
    270283        TYPE(c_ptr)                       :: array_adr
     284        TYPE(c_ptr)                       :: second_adr
    271285
    272286        dims = 1
     
    282296        array_adr = c_loc(array)
    283297
    284         CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
     298!
     299!--     In PALM's pointer version, two indices have to be stored internally.
     300!--     The active address of the data array is set in swap_timelevel
     301        IF ( PRESENT( array_2 ) )  THEN
     302          second_adr = c_loc(array_2)
     303          CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr, second_adr = second_adr)
     304        ELSE
     305           CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
     306        ENDIF
    285307
    286308        return
     
    510532   END SUBROUTINE Get_DA_names_from_client
    511533
    512    SUBROUTINE PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
     534   SUBROUTINE PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr, second_adr)
    513535      IMPLICIT none
    514536
     
    518540      INTEGER,INTENT(IN)                      :: dim_order
    519541      TYPE(c_ptr),INTENT(IN)                  :: array_adr
     542      TYPE(c_ptr),INTENT(IN),OPTIONAL         :: second_adr
    520543
    521544      INTEGER                                 :: i
     
    533556          ar%dim_order = dim_order
    534557          ar%data      = array_adr
     558          if(present(second_adr)) then
     559             ar%po_data(1) = array_adr
     560             ar%po_data(2) = second_adr
     561          else
     562             ar%po_data(1) = C_NULL_PTR
     563             ar%po_data(2) = C_NULL_PTR
     564          end if
    535565       end do
    536566
    537567      return
    538568   END SUBROUTINE PMC_S_SetArray
     569
     570
     571   SUBROUTINE PMC_S_Set_Active_data_array (ClientId,iactive)
     572      IMPLICIT none
     573
     574      INTEGER,INTENT(IN)                      :: ClientId
     575      INTEGER,INTENT(IN)                      :: iactive
     576
     577!--   local variables
     578      INTEGER                                 :: i, ip
     579      TYPE(PeDef),POINTER                     :: aPE
     580      TYPE(ArrayDef),POINTER                  :: ar
     581      CHARACTER(len=DA_Namelen)               :: myName
     582
     583      do ip=1,Clients(ClientId)%inter_npes
     584         aPE => Clients(ClientId)%PEs(ip)
     585         do while (PMC_S_GetNextArray ( ClientId, myName,ip))
     586            ar  => aPE%Arrays
     587            if(iactive == 1 .OR. iactive == 2)   then
     588               ar%data = ar%po_data(iactive)
     589            end if
     590         end do
     591      end do
     592
     593      return
     594   END SUBROUTINE PMC_S_Set_Active_data_array
    539595
    540596
Note: See TracChangeset for help on using the changeset viewer.