source: palm/trunk/SOURCE/chem_modules.f90 @ 3655

Last change on this file since 3655 was 3652, checked in by forkel, 5 years ago

Checks added for chemistry mechanism, parameter chem_mechanism added

  • Property svn:keywords set to Id
File size: 12.1 KB
RevLine 
[2615]1!> @file chem_modules.f90
2!------------------------------------------------------------------------------!
[2828]3! This file is part of the PALM model system.
[2615]4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
[3298]17! Copyright 2018-2018 Leibniz Universitaet Hannover
18! Copyright 2018-2018 Karlsruhe Institute of Technology
19! Copyright 2018-2018 Freie Universitaet Berlin
[2615]20!------------------------------------------------------------------------------!
21!
22! Current revisions:
[2828]23! -----------------
[2615]24!
[3298]25!
[2615]26! Former revisions:
27! -----------------
28! $Id: chem_modules.f90 3652 2019-01-07 15:29:59Z knoop $
[3652]29! parameter chem_mechanism added (basit)
30!
31!
32! 3636 2018-12-19 13:48:34Z raasch
[3636]33! nopointer option removed
34!
35! 3611 2018-12-07 14:14:11Z banzhafs
[3611]36! Minor formatting
37!
38! 3458 2018-10-30 14:51:23Z kanani
[3458]39! from chemistry branch r3443:
40! ??
[3611]41!
[3458]42! 3298 2018-10-02 12:21:11Z kanani
[3298]43! - Minor formatting
44! - Introduced Variables for Chemistry emissions Module (Russo)
45! - Variables and parameters added for 2d and profile output (basit)
46! - Converted scalar  emission factors  to 1-D array of 99 elements each (basit)
47! - Removed "__chem" directive (basit)
48!
49! 3282 2018-09-27 10:49:12Z basit
[2828]50! Initial revision
51!
52! Authors:
53! --------
54! @author Farah Kanani-Suehring
55! @author Basit Khan
[3458]56! @author Sabine Banzhaf
57! @author Emmanuele Russo
[2828]58!
[2615]59!------------------------------------------------------------------------------!
60! Description:
61! ------------
[3636]62!> Definition of global PALM-4U chemistry variables
[2615]63!------------------------------------------------------------------------------!
64!
[2828]65 MODULE chem_modules
[3085]66
[2615]67    USE chem_gasphase_mod,                                                     &   
68        ONLY: nspec, nvar, spc_names
69
[3085]70    USE control_parameters,                                                    &
71        ONLY: varnamelength
[2615]72
[3085]73    USE kinds
74
75    USE statistics,                                                            &
76        ONLY: pr_palm
77
78
[2615]79    IMPLICIT NONE
80
81    PUBLIC nspec
82    PUBLIC nvar
83    PUBLIC spc_names
84
[3611]85    INTEGER(iwp), DIMENSION(99) :: cs_pr_index            = 0
86    INTEGER(iwp) ::  ibc_cs_b                                                      !< integer flag for bc_cs_b
87    INTEGER(iwp) ::  ibc_cs_t                                                      !< integer flag for bc_cs_t
88    INTEGER(iwp) ::  cs_pr_count                           = 0 
89    INTEGER(iwp) ::  max_pr_cs                             = 0
90    INTEGER(iwp) ::  cs_vertical_gradient_level_ind(99,10) = -9999                 !< grid index values of cs_vertical_gradient_level_ind(s)
[2615]91
[3611]92    LOGICAL      ::  constant_top_csflux(99)               = .TRUE.                !< chem spcs at the top  orig .TRUE.
93    LOGICAL      ::  constant_csflux(99)                   = .TRUE.                !< chem spcs at namelist parameter   orig TRUE
94    LOGICAL      ::  call_chem_at_all_substeps             = .FALSE.               !< namelist parameter
95    LOGICAL      ::  chem_debug0                           = .FALSE.               !< namelist parameter flag for minimum print output
96    LOGICAL      ::  chem_debug1                           = .FALSE.               !< namelist parameter flag for print output
97    LOGICAL      ::  chem_debug2                           = .FALSE.               !< namelist parameter flag for further print output
98    LOGICAL      ::  chem_gasphase_on                      = .TRUE.                !< namelist parameter
99    LOGICAL      ::  emission_output_required              = .TRUE.                !< Logical Variable for requiring Emission Outputs
100    LOGICAL      ::  do_emis                               = .FALSE.               !< Flag for turning on chemistry emissions
101    LOGICAL      ::  cs_pr_namelist_found                  = .FALSE.               !< Namelist parameter: Names of t
102    LOGICAL      ::  do_depo                               = .FALSE.               !< namelist parameter for activation of deposition calculation
[2615]103
104
[3611]105!
[2615]106!-- Namelist parameters for creating initial chemistry profiles
[3611]107    REAL(wp) ::  wall_csflux (99,0:5)               = 0.0_wp                        !< namelist parameter
108    REAL(wp) ::  cs_vertical_gradient (99,10)       = 0.0_wp                        !< namelist parameter
109    REAL(wp) ::  cs_vertical_gradient_level (99,10) = -999999.9_wp                  !< namelist parameter
110    REAL(wp) ::  top_csflux ( 99 )                  = 0.0_wp                        !< namelist parameter
111    REAL(wp) ::  cs_surface_initial_change(99)      = 0.0_wp                        !< namelist parameter
112    REAL(wp) ::  surface_csflux(99 )                = 0.0_wp                        !< namelist parameter: fluxes where 'surface_csflux_name' is in the namelist
[2615]113
[3611]114    REAL(wp), DIMENSION(:), ALLOCATABLE               ::  bc_cs_t_val
115    REAL(wp), DIMENSION(:), ALLOCATABLE               ::  css                       !< scaling parameter for chem spcs
116    REAL(wp), DIMENSION(99)                           ::  cs_surface = 0.0_wp       !< Namelist parameter: Surface conc of chem spcs'
117    REAL(wp), DIMENSION(99,100)                       ::  cs_heights = 9999999.9_wp !< Namelist parameter: Height lvls(m) for cs_profiles
118    REAL(wp), DIMENSION(99,100)                       ::  cs_profile = 9999999.9_wp !< Namelist parameter: Chem conc for each spcs defined
[2615]119
[3611]120!
121!-- Use pointers cs, cs_p and tcs_m to point arrays cs_1, cs_2, and cs_3
122    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  cs_1                      !< pointer for swapping of timelevels for respective quantity
123    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  cs_2                      !< pointer for swapping of timelevels for respective quantity
124    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  cs_3                      !< pointer for swapping of timelevels for respective quantity
125    REAL(wp), DIMENSION(:,:,:), POINTER               ::  cs                        !< pointer: sgs chem spcs)
126    REAL(wp), DIMENSION(:,:,:), POINTER               ::  cs_p                      !< pointer: prognostic value of sgs chem spcs
127    REAL(wp), DIMENSION(:,:,:), POINTER               ::  tcs_m                     !< pointer:
[3282]128 
[3611]129    CHARACTER (LEN=20)                ::  bc_cs_b             = 'dirichlet'         !< namelist parameter
130    CHARACTER (LEN=20)                ::  bc_cs_t             = 'initial_gradient'  !< namelist parameter
131    CHARACTER (LEN=11), DIMENSION(99) ::  cs_name             = 'novalue'           !< Namelist parameter: chem spcs names
132    CHARACTER (LEN=11), DIMENSION(99) ::  cs_profile_name     = 'novalue'           !< Namelist parameter: Names of the chem for profiles
133    CHARACTER (LEN=11), DIMENSION(99) ::  surface_csflux_name = 'novalue'           !< Namelist parameter: chem species surface fluxes names
134                                                                                    !< active chem spcs, default is 'novalue')  ????
135    CHARACTER (LEN=80)                ::  mode_emis           ='PARAMETERIZED'      !< Mode of chemistry emissions: DEFAULT .OR. EXPERT .OR.
136                                                                                    !< PARAMETERIZED
137    CHARACTER (LEN=80)                ::  time_fac_type       ='MDH'                !< Type of time treatment in the emis DEFAULT mode: HOUR .OR. MDH
138    CHARACTER (LEN=80)                ::  daytype_mdh         ='workday'            !< Type of day in the MDH case: workday, weekend, holiday
[3652]139    CHARACTER (LEN=11), DIMENSION(99) ::  data_output_pr_cs   = 'novalue'           !< Namelist parameter: Names of the chem species for profile output
[3611]140                                                                                    !< by cs_name for each height lvls defined by cs_heights
[3652]141    CHARACTER (LEN=30)                ::  chem_mechanism      = 'phstatp'           !< Namelist parameter: Name of chemistry mechanism
142                                                                                    !< (must match with third line in chem_gasphase_mod.f90)
[2828]143!
144!-- Namelist parameters for chem_emissions
145    INTEGER(iwp) ::  main_street_id = 0
[3282]146    INTEGER(iwp) ::  max_street_id  = 0
[2828]147    INTEGER(iwp) ::  side_street_id = 0
148!
149!-- Constant emission factors
[3266]150    REAL(wp) ::  emiss_factor_main ( 99 ) = -9999.0_wp
151    REAL(wp) ::  emiss_factor_side ( 99 ) = -9999.0_wp
[3611]152!   
[3190]153!-- Other Emissions Variables
[3282]154    INTEGER(iwp) ::  nspec_out                                                     !< Output of routine chem_emis_matching with
155                                                                                   !< number of matched species
[3611]156    REAL(wp),ALLOCATABLE, DIMENSION(:,:,:,:) ::  emis_distribution                 !> Emissions Final Values (main module output)
[3190]157
[3611]158    INTEGER(iwp),ALLOCATABLE,DIMENSION(:)    ::  match_spec_input                  !< Index of Input chem species for matching routine
159    INTEGER(iwp),ALLOCATABLE,DIMENSION(:)    ::  match_spec_model                  !< Index of Model chem species for matching routine
160    INTEGER(iwp),ALLOCATABLE,DIMENSION(:)    ::  match_spec_voc_input              !< index of VOC input components matching the model's VOCs
161    INTEGER(iwp),ALLOCATABLE,DIMENSION(:)    ::  match_spec_voc_model              !< index of VOC model species matching the input VOCs comp.
162    INTEGER(iwp),DIMENSION(:)                ::  match_spec_pm(1:3)                !< results of matching the input and model's PMs
163    INTEGER(iwp),DIMENSION(:)                ::  match_spec_nox(1:2)               !< results of matching the input and model's NOx
164    INTEGER(iwp),DIMENSION(:)                ::  match_spec_sox(1:2)               !< results of matching the input and model's SOx!
165                                                                                 
[3190]166
[3611]167!
168!-- Selected atomic/molecular weights:
169    REAL, PARAMETER        ::  xm_H     =    1.00790e-3           !< kg/mol
170    REAL, PARAMETER        ::  xm_N     =   14.00670e-3           !< kg/mol
171    REAL, PARAMETER        ::  xm_C     =   12.01115e-3           !< kg/mol
172    REAL, PARAMETER        ::  xm_S     =   32.06400e-3           !< kg/mol
173    REAL, PARAMETER        ::  xm_O     =   15.99940e-3           !< kg/mol
174    REAL, PARAMETER        ::  xm_F     =   18.99840e-3           !< kg/mol
175    REAL, PARAMETER        ::  xm_Na    =   22.98977e-3           !< kg/mol
176    REAL, PARAMETER        ::  xm_Cl    =   35.45300e-3           !< kg/mol
177    REAL, PARAMETER        ::  xm_Rn222 =  222.00000e-3           !< kg/mol
178    REAL, PARAMETER        ::  xm_Pb210 =  210.00000e-3           !< kg/mol
179    REAL, PARAMETER        ::  xm_Ca    =   40.07800e-3           !< kg/mol
180    REAL, PARAMETER        ::  xm_K     =   39.09800e-3           !< kg/mol
181    REAL, PARAMETER        ::  xm_Mg    =   24.30500e-3           !< kg/mol
182    REAL, PARAMETER        ::  xm_Pb    =  207.20000e-3           !< kg/mol
183    REAL, PARAMETER        ::  xm_Cd    =  112.41000e-3           !< kg/mol
[3458]184   
[3611]185    REAL, PARAMETER        ::  xm_h2o   = xm_H * 2 + xm_O         !< kg/mol
186    REAL, PARAMETER        ::  xm_o3    = xm_O * 3                !< kg/mol
187    REAL, PARAMETER        ::  xm_N2O5  = xm_N * 2 + xm_O * 5     !< kg/mol
188    REAL, PARAMETER        ::  xm_HNO3  = xm_H + xm_N + xm_O * 3  !< kg/mol
189    REAL, PARAMETER        ::  xm_NH4   = xm_N + xm_H * 4         !< kg/mol
190    REAL, PARAMETER        ::  xm_SO4   = xm_S + xm_O * 4         !< kg/mol
191    REAL, PARAMETER        ::  xm_NO3   = xm_N + xm_O * 3         !< kg/mol
192    REAL, PARAMETER        ::  xm_CO2   = xm_C + xm_O * 2         !< kg/mol
[3458]193   
[3611]194!
195!-- mass of air
196    REAL, PARAMETER        ::  xm_air   =  28.964e-3              !< kg/mol
[3458]197       
[3611]198!
199!-- dummy weight, used for complex molecules:
[3458]200    REAL, PARAMETER        ::  xm_dummy =  1000.0e-3              ! kg/mol
201
202   
[2615]203    SAVE
[2828]204 END MODULE chem_modules
[2615]205
Note: See TracBrowser for help on using the repository browser.