Changeset 1766


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

pmc now runs with pointer version too

Location:
palm/trunk/SOURCE
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/Makefile

    r1765 r1766  
    2020# Current revisions:
    2121# ------------------
    22 #
     22# update dependency for swap_timelevel
    2323#
    2424# Former revisions:
     
    474474surface_coupler.o: modules.o cpulog.o mod_kinds.o
    475475surface_layer_fluxes.o: modules.o mod_kinds.o land_surface_model.o
    476 swap_timelevel.o: modules.o cpulog.o mod_kinds.o land_surface_model.o
     476swap_timelevel.o: modules.o cpulog.o mod_kinds.o land_surface_model.o\
     477   pmc_interface.o
    477478temperton_fft.o: modules.o mod_kinds.o
    478479time_integration.o: modules.o advec_ws.o buoyancy.o calc_mean_profile.o \
  • palm/trunk/SOURCE/pmc_general.f90

    r1765 r1766  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! +po_data in type arraydef
    2323!
    2424! Former revisions:
     
    7575      INTEGER,DIMENSION(4)          :: A_dim                       ! Size of dimensions
    7676      INTEGER                       :: dim_order                   ! Order of Dimensions: 2 = 2D array, 33 = 3D array
    77       TYPE (c_ptr)                  :: data                        ! Pointer of data in server space
     77      TYPE(c_ptr)                   :: data                        ! Pointer of data in server space
     78      TYPE(c_ptr), DIMENSION(2)     :: po_data                     ! Base Pointers, PMC_S_Set_Active_data_array sets active pointer
    7879      INTEGER(idp)                  :: BufIndex                    ! index in Send Buffer
    7980      INTEGER                       :: BufSize                     ! size in Send Buffer
  • palm/trunk/SOURCE/pmc_interface.f90

    r1765 r1766  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! modifications to allow for using PALM's pointer version,
     23! +new routine pmci_set_swaplevel
    2324!
    2425! Former revisions:
     
    4243!------------------------------------------------------------------------------!
    4344
     45#if defined( __nopointer )
     46!-- TO_DO: is it really required to use arrays te_m, tu_m, etc. and to set them
     47!--        to zero withi buildings?
    4448    USE arrays_3d,                                                             &
    4549        ONLY:  dzu, dzw, e, e_p, pt, pt_p, q, q_p, te_m, tu_m, tv_m, tw_m, u,  &
    4650               u_p, v, v_p, w, w_p, zu, zw, z0
     51#else
     52   USE arrays_3d,                                                              &
     53        ONLY:  dzu, dzw, e, e_p, e_1, e_2, pt, pt_p, pt_1, pt_2, q, q_p, q_1, q_2, te_m, tu_m, &
     54               tv_m, tw_m, u, u_p, u_1, u_2, v, v_p, v_1, v_2, w, w_p, w_1, w_2, zu, zw, z0
     55#endif
    4756
    4857    USE control_parameters,                                                    &
     
    94103        ONLY:  pmc_serverinit, pmc_s_fillbuffer, pmc_s_getdata_from_buffer,    &
    95104               pmc_s_getnextarray, pmc_s_setind_and_allocmem,                  &
    96                pmc_s_set_dataarray, pmc_s_set_2d_index_list
     105               pmc_s_set_active_data_array, pmc_s_set_dataarray,               &
     106               pmc_s_set_2d_index_list
    97107
    98108#endif
     
    309319    END INTERFACE
    310320
     321    INTERFACE pmci_set_swaplevel
     322       MODULE PROCEDURE pmci_set_swaplevel
     323    END INTERFACE pmci_set_swaplevel
     324
    311325    INTERFACE pmci_update_new
    312326       MODULE PROCEDURE pmci_update_new
     
    322336    PUBLIC pmci_server_initialize
    323337    PUBLIC pmci_server_synchronize
     338    PUBLIC pmci_set_swaplevel
    324339    PUBLIC pmci_update_new
    325340
     
    22142229 END SUBROUTINE pmci_client_synchronize
    22152230               
     2231
     2232
     2233 SUBROUTINE pmci_set_swaplevel( swaplevel )
     2234
     2235    IMPLICIT NONE
     2236
     2237    INTEGER(iwp),INTENT(IN) ::  swaplevel  !: swaplevel (1 or 2) of PALM's timestep
     2238
     2239    INTEGER(iwp)            ::  client_id  !:
     2240    INTEGER(iwp)            ::  m          !:
     2241
     2242!
     2243!-- After each timestep, alternately set buffer one or buffer two active
     2244    DO  m = 1, SIZE( pmc_server_for_client )-1
     2245       client_id = pmc_server_for_client(m)
     2246       CALL pmc_s_set_active_data_array( client_id, swaplevel )
     2247    ENDDO
     2248
     2249 END SUBROUTINE pmci_set_swaplevel
     2250
    22162251
    22172252
     
    33203355    w(nzt+1,:,:) = w(nzt,:,:)
    33213356
    3322 #if defined( __nopointer )
    3323 
    33243357    u_p  = u
    33253358    v_p  = v
     
    33313364    ENDIF
    33323365
    3333 #endif
    3334 
    33353366!
    33363367!-- TO_DO: Find out later if nesting would work without __nopointer.
     
    33513382#if defined( __parallel )
    33523383    REAL(wp), POINTER, DIMENSION(:,:)    ::  p_2d        !:
     3384    REAL(wp), POINTER, DIMENSION(:,:)    ::  p_2d_sec    !:
    33533385    REAL(wp), POINTER, DIMENSION(:,:,:)  ::  p_3d        !:
     3386    REAL(wp), POINTER, DIMENSION(:,:,:)  ::  p_3d_sec    !:
    33543387    INTEGER(iwp)                         ::  ierr        !:
    33553388    INTEGER(iwp)                         ::  istat       !:
     
    33693402    !IF ( TRIM(name) == "z0" )    p_2d => z0
    33703403
     3404#if defined( __nopointer )
    33713405    IF ( ASSOCIATED( p_3d ) )  THEN
    33723406       CALL pmc_s_set_dataarray( client_id, p_3d, nz_cl, nz )
     
    33873421       ENDIF
    33883422    ENDIF
     3423#else
     3424!-- TO_DO: Why aren't the other pointers (p_3d) not set to u_1, v_1, etc.??
     3425    IF ( TRIM(name) == "u" )     p_3d_sec => u_2
     3426    IF ( TRIM(name) == "v" )     p_3d_sec => v_2
     3427    IF ( TRIM(name) == "w" )     p_3d_sec => w_2
     3428    IF ( TRIM(name) == "e" )     p_3d_sec => e_2
     3429    IF ( TRIM(name) == "pt" )    p_3d_sec => pt_2
     3430    !IF ( TRIM(name) == "z0" )    p_2d_sec => z0_2
     3431
     3432    IF ( ASSOCIATED( p_3d ) )  THEN
     3433       CALL pmc_s_set_dataarray( client_id, p_3d, nz_cl, nz, &
     3434                                 array_2 = p_3d_sec )
     3435    ELSEIF ( ASSOCIATED( p_2d ) )  THEN
     3436       CALL pmc_s_set_dataarray( client_id, p_2d, array_2 = p_2d_sec )
     3437    ELSE
     3438!
     3439!--    Give only one message for the root domain
     3440       IF ( myid == 0  .AND.  cpl_id == 1 )  THEN
     3441
     3442          message_string = 'pointer for array "' // TRIM( name ) //            &
     3443                           '" can''t be associated'
     3444          CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
     3445       ELSE
     3446!
     3447!--       Avoid others to continue
     3448          CALL MPI_BARRIER( comm2d, ierr )
     3449       ENDIF
     3450
     3451   ENDIF
     3452#endif
    33893453
    33903454#endif
  • 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
  • palm/trunk/SOURCE/swap_timelevel.f90

    r1748 r1766  
    1919! Current revisions:
    2020! -----------------
    21 !
     21! setting the swap level for pmc data transfer
    2222!
    2323! Former revisions:
     
    9999    USE indices,                                                               &
    100100        ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt
     101
     102    USE pmc_interface,                                                         &
     103        ONLY: nested_run, pmci_set_swaplevel
     104
     105
    101106    IMPLICIT NONE
    102107
    103     INTEGER ::  i, j, k   !: loop indices
     108    INTEGER ::  i, j, k     !> loop indices
     109    INTEGER ::  swap_level  !> swap_level for steering the pmc data transfer
    104110
    105111!
     
    195201          ENDIF
    196202
     203          swap_level = 1
    197204
    198205       CASE ( 1 )
     
    223230          ENDIF
    224231
     232          swap_level = 2
    225233
    226234    END SELECT
     235
     236!
     237!-- Set the swap level for steering the pmc data transfer
     238    IF ( nested_run )  CALL pmci_set_swaplevel( swap_level )
    227239
    228240    CALL cpu_log( log_point(28), 'swap_timelevel', 'stop' )
Note: See TracChangeset for help on using the changeset viewer.