Ignore:
Timestamp:
Feb 19, 2020 8:16:04 PM (4 years ago)
Author:
suehring
Message:

Remove deprecated topography arrays; Move basic initialization of numerics into an extra module interface

File:
1 edited

Legend:

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

    r4360 r4414  
    2525! -----------------
    2626! $Id$
     27! Move call for initialization of control flags to ws_init
     28!
     29! 4360 2020-01-07 11:25:50Z suehring
    2730! Introduction of wall_flags_total_0, which currently sets bits based on static
    2831! topography information used in wall_flags_static_0
     
    379382
    380383       ENDIF
     384!
     385!--    Initialize the flag arrays controlling degradation near walls, i.e.
     386!--    to decrease the numerical stencil appropriately. The order of the scheme
     387!--    is degraded near solid walls as well as near non-cyclic inflow and outflow
     388!--    boundaries. Do this separately for momentum and scalars.
     389       IF ( ws_scheme_mom )  CALL ws_init_flags_momentum
     390
     391       IF ( ws_scheme_sca )  THEN
     392          ALLOCATE( advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     393          advc_flags_s = 0
     394          CALL ws_init_flags_scalar( bc_dirichlet_l  .OR.  bc_radiation_l,     &
     395                                     bc_dirichlet_n  .OR.  bc_radiation_n,     &
     396                                     bc_dirichlet_r  .OR.  bc_radiation_r,     &
     397                                     bc_dirichlet_s  .OR.  bc_radiation_s,     &
     398                                     advc_flags_s )
     399       ENDIF
    381400
    382401    END SUBROUTINE ws_init
     
    398417       INTEGER(iwp) ::  k_pp  !< dummy index along z
    399418       INTEGER(iwp) ::  k_ppp !< dummy index along z
    400        
     419
    401420       LOGICAL      ::  flag_set !< steering variable for advection flags
    402    
     421
     422       ALLOCATE( advc_flags_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    403423       advc_flags_m = 0
    404 
    405424!
    406425!--    Set advc_flags_m to steer the degradation of the advection scheme in advec_ws
     
    850869       INTEGER(iwp) ::  k_pp  !< dummy index along z
    851870       INTEGER(iwp) ::  k_ppp !< dummy index along z
    852        
     871
    853872       INTEGER(iwp), INTENT(INOUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::&
    854873                                                  advc_flag !< flag array to control order of scalar advection
    855        
     874
    856875       LOGICAL ::  flag_set     !< steering variable for advection flags
    857876       LOGICAL ::  non_cyclic_l !< flag that indicates non-cyclic boundary on the left
     
    859878       LOGICAL ::  non_cyclic_r !< flag that indicates non-cyclic boundary on the right
    860879       LOGICAL ::  non_cyclic_s !< flag that indicates non-cyclic boundary on the south
    861        
     880
    862881       LOGICAL, OPTIONAL ::  extensive_degrad !< flag indicating that extensive degradation is required, e.g. for
    863882                                              !< passive scalars nearby topography along the horizontal directions,
Note: See TracChangeset for help on using the changeset viewer.