Ignore:
Timestamp:
Jun 13, 2016 7:12:51 AM (9 years ago)
Author:
hellstea
Message:

last commit documented

File:
1 edited

Legend:

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

    r1932 r1933  
    2424! -----------------
    2525! $Id$
     26!
     27! 1932 2016-06-10 12:09:21Z suehring
     28! Initial version of purely vertical nesting introduced.
    2629!
    2730! 1931 2016-06-10 12:06:59Z suehring
     
    127130               gathered_size, ibc_p_b, ibc_p_t, intermediate_timestep_count,   &
    128131               intermediate_timestep_count_max, mg_switch_to_pe0_level,        &
    129                nest_domain, nest_bound_l, nest_bound_n, nest_bound_r,          &
    130                nest_bound_s, on_device, outflow_l, outflow_n, outflow_r,       &
     132               nest_domain, on_device, outflow_l, outflow_n, outflow_r,        &
    131133               outflow_s, psolver, subdomain_size, topography, volume_flow,    &
    132134               volume_flow_area, volume_flow_initial
     
    147149
    148150    USE pegrid
     151   
     152    USE pmc_interface,                                                         &
     153        ONLY:  nesting_mode
    149154
    150155    USE poisfft_mod,                                                           &
     
    174179    REAL(wp), DIMENSION(1:nzt) ::  w_l                 !<
    175180    REAL(wp), DIMENSION(1:nzt) ::  w_l_l               !<
     181
     182    LOGICAL :: nest_domain_nvn      !<
    176183
    177184
     
    312319!
    313320!-- Remove mean vertical velocity in case that Neumann conditions are
    314 !-- used both at bottom and top boundary, and if not a nested domain.
     321!-- used both at bottom and top boundary, and if not a nested domain in a
     322!-- normal nesting run. In case of vertical nesting, this must be done.
     323!-- Therefore an auxiliary logical variable nest_domain_nvn is used here, and
     324!-- nvn stands for non-vertical nesting.
    315325!-- This cannot be done before the first initial time step because ngp_2dh_outer
    316326!-- is not yet known then.
    317     IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1  .AND.  .NOT. nest_domain  .AND.    &
    318          intermediate_timestep_count /= 0 )                                    &
     327    nest_domain_nvn = nest_domain
     328    IF ( nest_domain .AND. nesting_mode == 'vertical' )  THEN
     329       nest_domain_nvn = .FALSE.
     330    ENDIF
     331
     332    IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1  .AND.                               &
     333         .NOT. nest_domain_nvn  .AND. intermediate_timestep_count /= 0 )        &
    319334    THEN
    320335       w_l = 0.0_wp;  w_l_l = 0.0_wp
Note: See TracChangeset for help on using the changeset viewer.