Changeset 2311 for palm/trunk


Ignore:
Timestamp:
Jul 13, 2017 1:34:42 PM (7 years ago)
Author:
suehring
Message:

Set bottom boundary conditions after nesting interpolation and anterpolation

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

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

    r2293 r2311  
    2626! -----------------
    2727! $Id$
     28! Set bottom boundary condition after anterpolation.
     29! Some variable description added.
     30!
     31! 2293 2017-06-22 12:59:12Z suehring
    2832! In anterpolation, exclude grid points which are used for interpolation.
    2933! This avoids the accumulation of numerical errors leading to increased
     
    422426    TYPE(coarsegrid_def), SAVE ::  cg   !:
    423427
     428    INTERFACE pmci_boundary_conds
     429       MODULE PROCEDURE pmci_boundary_conds
     430    END INTERFACE pmci_boundary_conds
    424431
    425432    INTERFACE pmci_check_setting_mismatches
     
    464471           cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode,         &
    465472           parent_to_child
     473
     474    PUBLIC pmci_boundary_conds
    466475    PUBLIC pmci_child_initialize
    467476    PUBLIC pmci_datatrans
     
    44824491      IF ( .NOT. neutral )  THEN
    44834492         CALL pmci_anterp_tophat( pt, ptc, kctu, iflo, ifuo, jflo, jfuo, kflo, &
    4484                                   kfuo, ijfc_s, kfc_s, 's' )
     4493                                  kfuo, ijfc_s, kfc_s, 'pt' )
    44854494      ENDIF
    44864495
     
    44884497
    44894498         CALL pmci_anterp_tophat( q, q_c, kctu, iflo, ifuo, jflo, jfuo, kflo,  &
    4490                                   kfuo, ijfc_s, kfc_s, 's' )
     4499                                  kfuo, ijfc_s, kfc_s, 'q' )
    44914500
    44924501         IF ( cloud_physics  .AND.  microphysics_morrison )  THEN
    44934502
    44944503            CALL pmci_anterp_tophat( qc, qcc, kctu, iflo, ifuo, jflo, jfuo,    &
    4495                                      kflo, kfuo, ijfc_s, kfc_s, 's' )
     4504                                     kflo, kfuo, ijfc_s, kfc_s, 'qc' )
    44964505
    44974506            CALL pmci_anterp_tophat( nc, ncc, kctu, iflo, ifuo, jflo, jfuo,    &
    4498                                      kflo, kfuo, ijfc_s, kfc_s,  's' )
     4507                                     kflo, kfuo, ijfc_s, kfc_s,  'nc' )
    44994508
    45004509         ENDIF
     
    45034512
    45044513            CALL pmci_anterp_tophat( qr, qrc, kctu, iflo, ifuo, jflo, jfuo,    &
    4505                                      kflo, kfuo, ijfc_s, kfc_s, 's' )
     4514                                     kflo, kfuo, ijfc_s, kfc_s, 'qr' )
    45064515
    45074516            CALL pmci_anterp_tophat( nr, nrc, kctu, iflo, ifuo, jflo, jfuo,    &
    4508                                      kflo, kfuo, ijfc_s, kfc_s, 's' )
     4517                                     kflo, kfuo, ijfc_s, kfc_s, 'nr' )
    45094518
    45104519         ENDIF
     
    53825391       IMPLICIT NONE
    53835392
    5384        CHARACTER(LEN=1), INTENT(IN) ::  var   !:
    5385 
    5386        INTEGER(iwp) ::  i         !: Fine-grid index
    5387        INTEGER(iwp) ::  ii        !: Coarse-grid index
    5388        INTEGER(iwp) ::  iclp      !:
    5389        INTEGER(iwp) ::  icrm      !:
    5390        INTEGER(iwp) ::  j         !: Fine-grid index
    5391        INTEGER(iwp) ::  jj        !: Coarse-grid index
    5392        INTEGER(iwp) ::  jcnm      !:
    5393        INTEGER(iwp) ::  jcsp      !:
    5394        INTEGER(iwp) ::  k         !: Fine-grid index       
    5395        INTEGER(iwp) ::  kk        !: Coarse-grid index
    5396        INTEGER(iwp) ::  kcb = 0   !:
    5397        INTEGER(iwp) ::  nfc       !:
    5398 
    5399        INTEGER(iwp), INTENT(IN) ::  kct   !:
    5400 
    5401        INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl         !:
    5402        INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu         !:
    5403        INTEGER(iwp), DIMENSION(jcs:jcn,icl:icr), INTENT(IN) :: ijfc !:
    5404        INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl         !:
    5405        INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu         !:
    5406        INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfc         !:
    5407        INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl         !:
    5408        INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu         !:
    5409 
    5410        REAL(wp) ::  cellsum   !:
    5411        REAL(wp) ::  f1f       !:
    5412        REAL(wp) ::  fra       !:
    5413 
    5414        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  f   !:
    5415        REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(INOUT)  ::  fc  !:
     5393       CHARACTER(LEN=*), INTENT(IN) ::  var   !< identifyer for treated variable
     5394
     5395       INTEGER(iwp) ::  i         !< Running index x-direction - fine-grid
     5396       INTEGER(iwp) ::  ii        !< Running index x-direction - coarse grid
     5397       INTEGER(iwp) ::  iclp      !< Left boundary index for anterpolation along x
     5398       INTEGER(iwp) ::  icrm      !< Right boundary index for anterpolation along x
     5399       INTEGER(iwp) ::  j         !< Running index y-direction - fine-grid
     5400       INTEGER(iwp) ::  jj        !< Running index y-direction - coarse grid
     5401       INTEGER(iwp) ::  jcnm      !< North boundary index for anterpolation along y
     5402       INTEGER(iwp) ::  jcsp      !< South boundary index for anterpolation along y
     5403       INTEGER(iwp) ::  k         !< Running index z-direction - fine-grid     
     5404       INTEGER(iwp) ::  kk        !< Running index z-direction - coarse grid
     5405       INTEGER(iwp) ::  kcb = 0   !< Bottom boundary index for anterpolation along z
     5406       INTEGER(iwp) ::  m         !< Running index surface type
     5407       INTEGER(iwp) ::  nfc       !<
     5408
     5409       INTEGER(iwp), INTENT(IN) ::  kct   !< Top boundary index for anterpolation along z
     5410
     5411       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl         !< Indicates start index of child cells belonging to certain parent cell - x direction
     5412       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu         !< Indicates end index of child cells belonging to certain parent cell - x direction
     5413       INTEGER(iwp), DIMENSION(jcs:jcn,icl:icr), INTENT(IN) :: ijfc !<
     5414       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl         !< Indicates start index of child cells belonging to certain parent cell - y direction
     5415       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu         !< Indicates start index of child cells belonging to certain parent cell - y direction
     5416       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfc         !<
     5417       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl         !< Indicates start index of child cells belonging to certain parent cell - z direction
     5418       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu         !< Indicates start index of child cells belonging to certain parent cell - z direction
     5419
     5420       REAL(wp) ::  cellsum   !< sum of respective child cells belonging to parent cell
     5421       REAL(wp) ::  fra       !< relaxation faction
     5422
     5423       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  f   !< Treated variable - child domain
     5424       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(INOUT)  ::  fc  !< Treated variable - parent domain
    54165425 
    54175426
     
    55015510       ENDDO
    55025511
     5512
    55035513    END SUBROUTINE pmci_anterp_tophat
    55045514
    55055515#endif
     5516
    55065517 END SUBROUTINE pmci_child_datatrans
    55075518
     5519! Description:
     5520! ------------
     5521!> Set boundary conditions for the prognostic quantities after interpolation
     5522!> and anterpolation at upward- and downward facing surfaces. 
     5523!> @todo: add Dirichlet boundary conditions for pot. temperature, humdidity and
     5524!> passive scalar.
     5525!------------------------------------------------------------------------------!
     5526 SUBROUTINE pmci_boundary_conds
     5527
     5528    USE control_parameters,                                                    &
     5529        ONLY:  ibc_pt_b, ibc_q_b, ibc_s_b, ibc_uv_b
     5530
     5531    USE surface_mod,                                                           &
     5532        ONLY:  bc_h
     5533
     5534    IMPLICIT NONE
     5535
     5536    INTEGER(iwp) ::  i  !< Index along x-direction
     5537    INTEGER(iwp) ::  j  !< Index along y-direction
     5538    INTEGER(iwp) ::  k  !< Index along z-direction
     5539    INTEGER(iwp) ::  m  !< Running index for surface type
     5540   
     5541!
     5542!-- Set Dirichlet boundary conditions for horizontal velocity components
     5543    IF ( ibc_uv_b == 0 )  THEN
     5544!
     5545!--    Upward-facing surfaces
     5546       DO  m = 1, bc_h(0)%ns
     5547          i = bc_h(0)%i(m)           
     5548          j = bc_h(0)%j(m)
     5549          k = bc_h(0)%k(m)
     5550          u(k-1,j,i) = 0.0_wp
     5551          v(k-1,j,i) = 0.0_wp
     5552       ENDDO
     5553!
     5554!--    Downward-facing surfaces
     5555       DO  m = 1, bc_h(1)%ns
     5556          i = bc_h(1)%i(m)           
     5557          j = bc_h(1)%j(m)
     5558          k = bc_h(1)%k(m)
     5559          u(k+1,j,i) = 0.0_wp
     5560          v(k+1,j,i) = 0.0_wp
     5561       ENDDO
     5562    ENDIF
     5563!
     5564!-- Set Dirichlet boundary conditions for vertical velocity component
     5565!-- Upward-facing surfaces
     5566    DO  m = 1, bc_h(0)%ns
     5567       i = bc_h(0)%i(m)           
     5568       j = bc_h(0)%j(m)
     5569       k = bc_h(0)%k(m)
     5570       w(k-1,j,i) = 0.0_wp
     5571    ENDDO
     5572!
     5573!-- Downward-facing surfaces
     5574    DO  m = 1, bc_h(1)%ns
     5575       i = bc_h(1)%i(m)           
     5576       j = bc_h(1)%j(m)
     5577       k = bc_h(1)%k(m)
     5578       w(k+1,j,i) = 0.0_wp
     5579    ENDDO
     5580!
     5581!-- Set Neumann boundary conditions for potential temperature
     5582    IF ( .NOT. neutral )  THEN
     5583       IF ( ibc_pt_b == 1 )  THEN
     5584          DO  m = 1, bc_h(0)%ns
     5585             i = bc_h(0)%i(m)           
     5586             j = bc_h(0)%j(m)
     5587             k = bc_h(0)%k(m)
     5588             pt(k-1,j,i) = pt(k,j,i)
     5589          ENDDO
     5590          DO  m = 1, bc_h(1)%ns
     5591             i = bc_h(1)%i(m)           
     5592             j = bc_h(1)%j(m)
     5593             k = bc_h(1)%k(m)
     5594             pt(k+1,j,i) = pt(k,j,i)
     5595          ENDDO   
     5596       ENDIF
     5597    ENDIF
     5598
     5599!
     5600!-- Set Neumann boundary conditions for humidity and cloud-physical quantities
     5601    IF ( humidity )  THEN
     5602       IF ( ibc_q_b == 1 )  THEN
     5603          DO  m = 1, bc_h(0)%ns
     5604             i = bc_h(0)%i(m)           
     5605             j = bc_h(0)%j(m)
     5606             k = bc_h(0)%k(m)
     5607             q(k-1,j,i) = q(k,j,i)
     5608          ENDDO 
     5609          DO  m = 1, bc_h(1)%ns
     5610             i = bc_h(1)%i(m)           
     5611             j = bc_h(1)%j(m)
     5612             k = bc_h(1)%k(m)
     5613             q(k+1,j,i) = q(k,j,i)
     5614          ENDDO 
     5615       ENDIF
     5616       IF ( cloud_physics  .AND.  microphysics_morrison )  THEN
     5617          DO  m = 1, bc_h(0)%ns
     5618             i = bc_h(0)%i(m)           
     5619             j = bc_h(0)%j(m)
     5620             k = bc_h(0)%k(m)
     5621             nc(k-1,j,i) = 0.0_wp
     5622             qc(k-1,j,i) = 0.0_wp
     5623          ENDDO 
     5624          DO  m = 1, bc_h(1)%ns
     5625             i = bc_h(1)%i(m)           
     5626             j = bc_h(1)%j(m)
     5627             k = bc_h(1)%k(m)
     5628
     5629             nc(k+1,j,i) = 0.0_wp
     5630             qc(k+1,j,i) = 0.0_wp
     5631          ENDDO 
     5632       ENDIF
     5633
     5634       IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
     5635          DO  m = 1, bc_h(0)%ns
     5636             i = bc_h(0)%i(m)           
     5637             j = bc_h(0)%j(m)
     5638             k = bc_h(0)%k(m)
     5639             nr(k-1,j,i) = 0.0_wp
     5640             qr(k-1,j,i) = 0.0_wp
     5641          ENDDO 
     5642          DO  m = 1, bc_h(1)%ns
     5643             i = bc_h(1)%i(m)           
     5644             j = bc_h(1)%j(m)
     5645             k = bc_h(1)%k(m)
     5646             nr(k+1,j,i) = 0.0_wp
     5647             qr(k+1,j,i) = 0.0_wp
     5648          ENDDO 
     5649       ENDIF
     5650
     5651    ENDIF
     5652!
     5653!-- Set Neumann boundary conditions for passive scalar
     5654    IF ( passive_scalar )  THEN
     5655       IF ( ibc_s_b == 1 )  THEN
     5656          DO  m = 1, bc_h(0)%ns
     5657             i = bc_h(0)%i(m)           
     5658             j = bc_h(0)%j(m)
     5659             k = bc_h(0)%k(m)
     5660             s(k-1,j,i) = s(k,j,i)
     5661          ENDDO
     5662          DO  m = 1, bc_h(1)%ns
     5663             i = bc_h(1)%i(m)           
     5664             j = bc_h(1)%j(m)
     5665             k = bc_h(1)%k(m)
     5666             s(k-1,j,i) = s(k,j,i)
     5667          ENDDO 
     5668       ENDIF
     5669    ENDIF
     5670
     5671 END SUBROUTINE pmci_boundary_conds
     5672
    55085673END MODULE pmc_interface
  • palm/trunk/SOURCE/time_integration.f90

    r2299 r2311  
    2525! -----------------
    2626! $Id$
     27! Set bottom boundary conditions after nesting interpolation and anterpolation
     28!
     29! 2299 2017-06-29 10:14:38Z maronga
    2730! Call of soil model adjusted
    2831!
     
    356359
    357360    USE pmc_interface,                                                         &
    358         ONLY:  nested_run, nesting_mode, pmci_datatrans,                       &
     361        ONLY:  nested_run, nesting_mode, pmci_boundary_conds, pmci_datatrans,  &
    359362               pmci_ensure_nest_mass_conservation, pmci_synchronize
    360363
     
    664667                IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e, nbgp )
    665668             ENDIF
     669!
     670!--          Set boundary conditions again after interpolation and anterpolation.
     671             CALL pmci_boundary_conds
    666672!
    667673!--          Correct the w top-BC in nest domains to ensure mass conservation.
Note: See TracChangeset for help on using the changeset viewer.