Ignore:
Timestamp:
Apr 30, 2020 12:20:40 PM (4 years ago)
Author:
raasch
Message:

chemistry decycling replaced by explicit setting of lateral boundary conditions

File:
1 edited

Legend:

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

    r4481 r4511  
    2222! Current revisions:
    2323! -----------------
    24 !
     24! 
    2525!
    2626! Former revisions:
    2727! -----------------
    2828! $Id$
     29! new variables for explicit settings of lateral boundary conditions introduced
     30!
     31! 4481 2020-03-31 18:55:54Z maronga
    2932! added namelist flag 'emiss_read_legacy_mode' to allow concurrent
    3033! functioning of new emission read mode under development (ECC)
     
    9295
    9396    CHARACTER (LEN=20) ::  bc_cs_b        = 'dirichlet'         !< namelist parameter: surface boundary condition for concentration
     97    CHARACTER (LEN=20) ::  bc_cs_l        = 'undefined'         !< left boundary condition
     98    CHARACTER (LEN=20) ::  bc_cs_n        = 'undefined'         !< north boundary condition
     99    CHARACTER (LEN=20) ::  bc_cs_r        = 'undefined'         !< right boundary condition
     100    CHARACTER (LEN=20) ::  bc_cs_s        = 'undefined'         !< south boundary condition
    94101    CHARACTER (LEN=20) ::  bc_cs_t        = 'initial_gradient'  !< namelist parameter: top boudary condition for concentration
    95102    CHARACTER (LEN=30) ::  chem_mechanism = 'phstatp'           !< namelist parameter: chemistry mechanism
     
    105112    CHARACTER (LEN=11), DIMENSION(99) ::  data_output_pr_cs   = 'novalue'  !< namelist parameter: tbc...???
    106113    CHARACTER (LEN=11), DIMENSION(99) ::  surface_csflux_name = 'novalue'  !< namelist parameter: tbc...???
     114
     115    INTEGER(iwp) ::  communicator_chem      !< stores the number of the MPI communicator to be used
     116                                            !< for ghost layer data exchange
     117                                            !< 1: cyclic, 2: cyclic along x, 3: cyclic along y,
     118                                            !< 4: non-cyclic
    107119
    108120    INTEGER(iwp) ::  cs_pr_count                           = 0      !< counter for chemical species profiles
     
    131143                                                                     !< chemical species near walls and lateral boundaries
    132144
     145    LOGICAL ::  bc_dirichlet_cs_l         = .FALSE.  !< flag for indicating a dirichlet condition at
     146                                                     !< the left boundary
     147    LOGICAL ::  bc_dirichlet_cs_n         = .FALSE.  !< flag for indicating a dirichlet condition at
     148                                                     !< the north boundary
     149    LOGICAL ::  bc_dirichlet_cs_r         = .FALSE.  !< flag for indicating a dirichlet condition at
     150                                                     !< the right boundary
     151    LOGICAL ::  bc_dirichlet_cs_s         = .FALSE.  !< flag for indicating a dirichlet condition at
     152                                                     !< the south boundary
     153    LOGICAL ::  bc_radiation_cs_l         = .FALSE.  !< flag for indicating a radiation/neumann
     154                                                     !< condition at the left boundary
     155    LOGICAL ::  bc_radiation_cs_n         = .FALSE.  !< flag for indicating a radiation/neumann
     156                                                     !< condition at the north boundary
     157    LOGICAL ::  bc_radiation_cs_r         = .FALSE.  !< flag for indicating a radiation/neumann
     158                                                     !< condition at the right boundary
     159    LOGICAL ::  bc_radiation_cs_s         = .FALSE.  !< flag for indicating a radiation/neumann
     160                                                     !< condition at the south boundary
    133161    LOGICAL ::  constant_top_csflux(99)   = .TRUE.   !< internal flag, set to .FALSE. if no top_csflux is prescribed
    134162    LOGICAL ::  constant_csflux(99)       = .TRUE.   !< internal flag, set to .FALSE. if no surface_csflux is prescribed
Note: See TracChangeset for help on using the changeset viewer.