Changeset 3819 for palm


Ignore:
Timestamp:
Mar 27, 2019 11:01:36 AM (5 years ago)
Author:
hellstea
Message:

Adjustable anterpolation buffer introduced on all nest boundaries

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

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

    r3655 r3819  
    2525! -----------------
    2626! $Id$
     27! Adjustable anterpolation buffer introduced on all nest boundaries, it is controlled
     28! by the new nesting_parameters parameter anterpolation_buffer_width.
     29!
     30! 3655 2019-01-07 16:51:22Z knoop
    2731! nestpar renamed to nesting_parameters
    2832!
     
    185189
    186190 SUBROUTINE pmc_init_model( comm, nesting_datatransfer_mode, nesting_mode,      &
    187                             pmc_status )
     191                            anterpolation_buffer_width, pmc_status )
    188192
    189193    USE control_parameters,                                                     &
     
    198202    CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode  !<
    199203
     204    INTEGER, INTENT(INOUT) ::  anterpolation_buffer_width          !< Boundary buffer width for anterpolation
    200205    INTEGER, INTENT(INOUT) ::  comm        !<
    201206    INTEGER, INTENT(INOUT) ::  pmc_status  !<
     
    226231
    227232       CALL read_coupling_layout( nesting_datatransfer_mode, nesting_mode,      &
    228                                   pmc_status )
     233                                  anterpolation_buffer_width, pmc_status )
    229234
    230235       IF ( pmc_status /= pmc_no_namelist_found  .AND.                          &
     
    473478
    474479 SUBROUTINE read_coupling_layout( nesting_datatransfer_mode, nesting_mode,      &
    475       pmc_status )
     480      anterpolation_buffer_width, pmc_status )
    476481
    477482    IMPLICIT NONE
     
    479484    CHARACTER(LEN=8), INTENT(INOUT) ::  nesting_mode
    480485    CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode
    481 
     486   
     487    INTEGER, INTENT(INOUT)      ::  anterpolation_buffer_width     !< Boundary buffer width for anterpolation
    482488    INTEGER(iwp), INTENT(INOUT) ::  pmc_status
    483489    INTEGER(iwp)                ::  bad_llcorner
     
    488494
    489495    NAMELIST /nesting_parameters/  domain_layouts, nesting_datatransfer_mode,  &
    490                                    nesting_mode
     496                                   nesting_mode, anterpolation_buffer_width
    491497   
    492498!
  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r3804 r3819  
    2525! -----------------
    2626! $Id$
     27! Adjustable anterpolation buffer introduced on all nest boundaries, it is controlled
     28! by the new nesting_parameters parameter anterpolation_buffer_width.
     29!
     30! 3804 2019-03-19 13:46:20Z hellstea
    2731! Anterpolation domain is lowered from kct-1 to kct-3 to avoid exessive       
    2832! kinetic energy from building up in CBL flows.
     
    463467    INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !<
    464468    INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !<
    465     INTEGER(iwp), PARAMETER ::  interpolation_scheme_lrsn = 2  !< Interpolation scheme to be used on lateral boundaries (to be made user parameter)
    466     INTEGER(iwp), PARAMETER ::  interpolation_scheme_t    = 3  !< Interpolation scheme to be used on top boundary (to be made user parameter)
     469    INTEGER(iwp), PARAMETER ::  interpolation_scheme_lrsn  = 2  !< Interpolation scheme to be used on lateral boundaries (maybe to be made user parameter)
     470    INTEGER(iwp), PARAMETER ::  interpolation_scheme_t     = 3  !< Interpolation scheme to be used on top boundary (maybe to be made user parameter)
    467471!
    468472!-- Coupler setup
     
    476480    CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !< steering parameter for data-transfer mode
    477481    CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'             !< steering parameter for 1- or 2-way nesting
    478 
     482    INTEGER(iwp),     SAVE ::  anterpolation_buffer_width = 2       !< Boundary buffer width for anterpolation
     483   
    479484    LOGICAL, SAVE ::  nested_run = .FALSE.  !< general switch
    480485    LOGICAL       ::  rans_mode_parent = .FALSE. !< mode of parent model (.F. - LES mode, .T. - RANS mode)
     
    511516    INTEGER(iwp), SAVE ::  igsr     !< Integer grid-spacing ratio in i-direction
    512517    INTEGER(iwp), SAVE ::  jgsr     !< Integer grid-spacing ratio in j-direction
    513     INTEGER(iwp), SAVE ::  kgsr     !< Integer grid-spacing ratio in k-direction
     518    INTEGER(iwp), SAVE ::  kgsr     !< Integer grid-spacing ratio in k-direction
     519!
     520!-- Global parent-grid index bounds
     521    INTEGER(iwp), SAVE ::  iplg     !< Leftmost parent-grid array ip index of the whole child domain
     522    INTEGER(iwp), SAVE ::  iprg     !< Rightmost parent-grid array ip index of the whole child domain
     523    INTEGER(iwp), SAVE ::  jpsg     !< Southmost parent-grid array jp index of the whole child domain
     524    INTEGER(iwp), SAVE ::  jpng     !< Northmost parent-grid array jp index of the whole child domain
     525!
     526!-- Local parent-grid index bounds (to be moved here from pmci_setup_child)
     527!-- EXPLAIN WHY SEVERAL SETS OF PARENT-GRID INDEX BOUNDS ARE NEEDED.
     528   
    514529!
    515530!-- Highest prognostic parent-grid k-indices.
     
    551566    REAL(wp), DIMENSION(2)              ::  zmax_coarse             !<
    552567
    553     TYPE coarsegrid_def
     568    TYPE parentgrid_def
    554569       INTEGER(iwp)                        ::  nx                 !<
    555570       INTEGER(iwp)                        ::  ny                 !<
     
    568583       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu                 !<
    569584       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw                 !<
    570     END TYPE coarsegrid_def
    571 
    572     TYPE(coarsegrid_def), SAVE, PUBLIC     ::  cg   !<
     585    END TYPE parentgrid_def
     586
     587    TYPE(parentgrid_def), SAVE, PUBLIC     ::  cg                 !< change to pg
    573588!
    574589!-- Variables for particle coupling
     
    677692
    678693    CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode,  &
    679                          pmc_status )
     694                         anterpolation_buffer_width, pmc_status )
    680695
    681696    IF ( pmc_status == pmc_no_namelist_found )  THEN
     
    10721087!--       Compute size of index_list.
    10731088          ic = 0         
    1074           DO  k = 1, size_of_array(2)
     1089          DO  k = 1, size_of_array(2)           ! Replace k by some other letter
    10751090             ic = ic + ( coarse_bound_all(4,k) - coarse_bound_all(3,k) + 1 ) * &
    10761091                       ( coarse_bound_all(2,k) - coarse_bound_all(1,k) + 1 )
     
    10891104!
    10901105!--       Loop over all children PEs
    1091           DO  k = 1, size_of_array(2)
     1106          DO  k = 1, size_of_array(2)           ! Replace k by some other letter
    10921107!
    10931108!--          Area along y required by actual child PE
     
    13861401       IMPLICIT NONE
    13871402
    1388        INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all   !<
    1389        INTEGER(iwp), DIMENSION(2)          ::  size_of_array      !<
     1403       INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all     !< Transfer array for parent-grid index bounds
     1404       INTEGER(iwp), DIMENSION(4)          ::  parent_bound_global  !< Transfer array for global parent-grid index bounds
     1405       INTEGER(iwp), DIMENSION(2)          ::  size_of_array        !<
    13901406       INTEGER(iwp) :: i        !<
    13911407       INTEGER(iwp) :: iauxl    !<
     
    14961512#endif       
    14971513
    1498        WRITE(9,"('Pmci_map_fine_to_coarse_grid. parent-grid array bounds: ',4(i3,2x))") icl, icr, jcs, jcn
     1514       WRITE(9,"('Pmci_map_fine_to_coarse_grid. Parent-grid array bounds: ',4(i4,2x))") icl, icr, jcs, jcn
    14991515       FLUSH(9)
    15001516
     
    15121528!
    15131529!--    Note that MPI_Gather receives data from all processes in the rank order
    1514 !--    TO_DO: refer to the line where this fact becomes important
     1530!--    This fact is exploited in creating the index list in pmci_create_index_list
    15151531       CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5,     &
    15161532                        MPI_INTEGER, 0, comm2d, ierr )
     
    15211537          CALL pmc_send_to_parent( size_of_array, 2, 0, 40, ierr )
    15221538          CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ), &
    1523                                    0, 41, ierr )
    1524        ENDIF
    1525 
     1539               0, 41, ierr )
     1540!
     1541!--       Determine the global parent-grid index bounds       
     1542          parent_bound_global(1) = MINVAL( coarse_bound_all(1,:) )
     1543          parent_bound_global(2) = MAXVAL( coarse_bound_all(2,:) )
     1544          parent_bound_global(3) = MINVAL( coarse_bound_all(3,:) )
     1545          parent_bound_global(4) = MAXVAL( coarse_bound_all(4,:) )
     1546       ENDIF
     1547!
     1548!--    Broadcat the global parent-grid index bounds to all current child processes
     1549       CALL MPI_BCAST( parent_bound_global, 4, MPI_INTEGER, 0, comm2d, ierr )
     1550       iplg = parent_bound_global(1)
     1551       iprg = parent_bound_global(2)
     1552       jpsg = parent_bound_global(3)
     1553       jpng = parent_bound_global(4)
     1554       WRITE(9,"('Pmci_map_fine_to_coarse_grid. Global parent-grid index bounds iplg, iprg, jpsg, jpng: ',4(i4,2x))") iplg, iprg, jpsg, jpng
     1555       FLUSH(9)
     1556       
    15261557    END SUBROUTINE pmci_map_fine_to_coarse_grid
    15271558
     
    16231654!
    16241655!--       Print out the index bounds for checking and debugging purposes
    1625           WRITE(9,"('pmci_init_anterp_tophat, ii, iflu, ifuu: ', 3(i4,2x))")    &
     1656          WRITE(9,"('pmci_define_index_mapping, ii, iflu, ifuu: ', 3(i4,2x))")    &
    16261657               ii, iflu(ii), ifuu(ii)
    16271658          FLUSH(9)
     
    16481679!
    16491680!--       Print out the index bounds for checking and debugging purposes
    1650           WRITE(9,"('pmci_init_anterp_tophat, ii, iflo, ifuo: ', 3(i4,2x))")    &
     1681          WRITE(9,"('pmci_define_index_mapping, ii, iflo, ifuo: ', 3(i4,2x))")    &
    16511682               ii, iflo(ii), ifuo(ii)
    16521683          FLUSH(9)
     
    16691700!
    16701701!--       Print out the index bounds for checking and debugging purposes
    1671           WRITE(9,"('pmci_init_anterp_tophat, jj, jflv, jfuv: ', 3(i4,2x))")    &
     1702          WRITE(9,"('pmci_define_index_mapping, jj, jflv, jfuv: ', 3(i4,2x))")    &
    16721703               jj, jflv(jj), jfuv(jj)
    16731704          FLUSH(9)
     
    16941725!
    16951726!--       Print out the index bounds for checking and debugging purposes
    1696           WRITE(9,"('pmci_init_anterp_tophat, jj, jflo, jfuo: ', 3(i4,2x))")    &
     1727          WRITE(9,"('pmci_define_index_mapping, jj, jflo, jfuo: ', 3(i4,2x))")    &
    16971728               jj, jflo(jj), jfuo(jj)
    16981729          FLUSH(9)
     
    17191750!
    17201751!--       Print out the index bounds for checking and debugging purposes
    1721           WRITE(9,"('pmci_init_anterp_tophat, kk, kflw, kfuw: ', 4(i4,2x), 2(e12.5,2x))") &
     1752          WRITE(9,"('pmci_define_index_mapping, kk, kflw, kfuw: ', 4(i4,2x), 2(e12.5,2x))") &
    17221753               kk, kflw(kk), kfuw(kk), nzt,  cg%zu(kk), cg%zw(kk)
    17231754          FLUSH(9)
     
    17551786!--    Print out the index bounds for checking and debugging purposes
    17561787       DO  kk = 1, cg%nz+1
    1757           WRITE(9,"('pmci_init_anterp_tophat, kk, kflo, kfuo: ', 4(i4,2x), 2(e12.5,2x))") &
     1788          WRITE(9,"('pmci_define_index_mapping, kk, kflo, kfuo: ', 4(i4,2x), 2(e12.5,2x))") &
    17581789               kk, kflo(kk), kfuo(kk), nzt,  cg%zu(kk), cg%zw(kk)
    17591790          FLUSH(9)
     
    22422273
    22432274
    2244 SUBROUTINE  get_child_gridspacing (m, dx,dy,dz)
     2275SUBROUTINE  get_child_gridspacing( m, dx,dy,dz )
    22452276
    22462277   IMPLICIT NONE
     
    28682899!-- an argument to allow for example to force one-way initialization
    28692900!-- phase.
     2901!-- Note that interpolation ( parent_to_child ) must always be carried
     2902!-- out before anterpolation ( child_to_parent ).
    28702903
    28712904    IMPLICIT NONE
     
    41614194!--   Define the index bounds iclant, icrant, jcsant and jcnant.
    41624195!--   Note that kcb is simply zero and kct enters here as a parameter and it is
    4163 !--   determined in pmci_init_anterp_tophat.
    4164 !--   Please note, grid points used also for interpolation (from parent to
     4196!--   determined in pmci_define_index_mapping.
     4197!--   Note that the grid points used also for interpolation (from parent to
    41654198!--   child) are excluded in anterpolation, e.g. anterpolation is only from
    4166 !--   nzb:kct-1, as kct is used for interpolation.
    4167 !--
    4168 !--   Note that kctant is changed from kct-1 to kct-3 to avoid exessive       
    4169 !--   kinetic energy from building up in CBL flows.
     4199!--   nzb:kct-1, as kct is used for interpolation. An additional buffer is
     4200!--   also applied (default value for anterpolation_buffer_width = 2) in order
     4201!--   to avoid unphysical accumulation of kinetic energy.
    41704202      iclant = icl
    41714203      icrant = icr
     
    41734205      jcnant = jcn
    41744206!      kctant = kct - 1
    4175       kctant = kct - 3
    4176      
     4207      kctant = kct - 1 - anterpolation_buffer_width
    41774208      kcb  = 0
    41784209      IF ( nesting_mode /= 'vertical' )  THEN
    4179          IF ( bc_dirichlet_l )  THEN
    4180             iclant = icl + 3
    4181          ENDIF
    4182          IF ( bc_dirichlet_r )  THEN
    4183             icrant = icr - 3
    4184          ENDIF
    4185 
    4186          IF ( bc_dirichlet_s )  THEN
    4187             jcsant = jcs + 3
    4188          ENDIF
    4189          IF ( bc_dirichlet_n )  THEN
    4190             jcnant = jcn - 3
    4191          ENDIF
     4210!         IF ( bc_dirichlet_l )  THEN
     4211!!            iclant = icl + 3
     4212!            iclant = icl + 3 + anterpolation_buffer_width
     4213!         ENDIF
     4214!         IF ( bc_dirichlet_r )  THEN
     4215!!            icrant = icr - 3
     4216!            icrant = icr - 3 - anterpolation_buffer_width
     4217!         ENDIF
     4218!
     4219!         IF ( bc_dirichlet_s )  THEN
     4220!!            jcsant = jcs + 3
     4221!            jcsant = jcs + 3 + anterpolation_buffer_width
     4222!         ENDIF
     4223!         IF ( bc_dirichlet_n )  THEN
     4224!!            jcnant = jcn - 3
     4225!            jcnant = jcn - 3 - anterpolation_buffer_width
     4226!         ENDIF
     4227
     4228!
     4229!--      New method:
     4230         iclant = MAX( icl, iplg + 3 + anterpolation_buffer_width )
     4231         icrant = MIN( icr, iprg - 3 - anterpolation_buffer_width )
     4232         jcsant = MAX( jcs, jpsg + 3 + anterpolation_buffer_width )
     4233         jcnant = MIN( jcn, jpng - 3 - anterpolation_buffer_width )
     4234         
    41924235      ENDIF
    41934236!
     
    42034246      ENDIF
    42044247!
    4205 !--   Note that ii, jj, and kk are coarse-grid indices and i,j, and k
    4206 !--   are fine-grid indices.
     4248!--   Note that l, m, and n are parent-grid indices and i,j, and k
     4249!--   are child-grid indices.
    42074250      DO  l = iclant, icrant
    42084251         DO  m = jcsant, jcnant
Note: See TracChangeset for help on using the changeset viewer.