Changeset 4559 for palm/trunk/SOURCE/chemistry_model_mod.f90
- Timestamp:
- Jun 11, 2020 8:51:48 AM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/chemistry_model_mod.f90
r4550 r4559 1 1 !> @file chemistry_model_mod.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 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/>. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 8 ! 9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 12 ! 13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 2017-2020 Leibniz Universitaet Hannover 18 17 ! Copyright 2017-2020 Karlsruhe Institute of Technology 19 18 ! Copyright 2017-2020 Freie Universitaet Berlin 20 !------------------------------------------------------------------------------ !19 !--------------------------------------------------------------------------------------------------! 21 20 ! 22 21 ! Current revisions: … … 27 26 ! ----------------- 28 27 ! $Id$ 28 ! file re-formatted to follow the PALM coding standard 29 ! 30 ! 4550 2020-05-29 15:22:13Z raasch 29 31 ! bugfix for reading local restart data 30 ! 32 ! 31 33 ! 4544 2020-05-21 14:43:05Z raasch 32 34 ! conc_av changed from pointer to allocatable array, array spec_conc_av removed 33 ! 35 ! 34 36 ! 4542 2020-05-19 15:45:12Z raasch 35 37 ! redundant if statement removed 36 ! 38 ! 37 39 ! 4535 2020-05-15 12:07:23Z raasch 38 40 ! bugfix for restart data format query 39 ! 41 ! 40 42 ! 4517 2020-05-03 14:29:30Z raasch 41 43 ! added restart with MPI-IO 42 ! 44 ! 43 45 ! 4511 2020-04-30 12:20:40Z raasch 44 46 ! decycling replaced by explicit setting of lateral boundary conditions … … 50 52 ! use statement for exchange horiz added, 51 53 ! bugfix for call of exchange horiz 2d 52 ! 54 ! 53 55 ! 4442 2020-03-04 19:21:13Z suehring 54 ! Change order of dimension in surface array %frac to allow for better 56 ! Change order of dimension in surface array %frac to allow for better 55 57 ! vectorization. 56 58 ! 57 59 ! 4441 2020-03-04 19:20:35Z suehring 58 60 ! in subroutine chem_init (ECC) 59 ! - allows different init paths emission data for legacy 60 ! mode emission and on-demand mode 61 ! in subroutine chem_init_internal (ECC) 62 ! - reads netcdf file only when legacy mode is activated 63 ! (i.e., emiss_read_legacy_mode = .TRUE.) 64 ! otherwise file is read once at the beginning to obtain 65 ! header information, and emission data are extracted on 66 ! an on-demand basis 61 ! - allows different init paths emission data for legacy mode emission and on-demand mode in 62 ! subroutine chem_init_internal (ECC) 63 ! - reads netcdf file only when legacy mode is activated (i.e., emiss_read_legacy_mode = .TRUE.) 64 ! otherwise file is read once at the beginning to obtain header information, and emission data 65 ! are extracted on an on-demand basis 67 66 ! 68 67 ! 4372 2020-01-14 10:20:35Z banzhafs 69 ! chem_parin : added handler for new namelist item emiss_legacy_read_mode (ECC) 70 ! added messages 68 ! chem_parin : added handler for new namelist item emiss_legacy_read_mode (ECC) added messages 71 69 ! CM0465 - legacy read mode selection 72 70 ! CM0466 - legacy read mode force selection 73 71 ! CM0467 - new read mode selection 74 72 ! 75 ! 4370 2020-01-10 14:00:44Z raasch 73 ! 4370 2020-01-10 14:00:44Z raasch 76 74 ! vector directives added to force vectorization on Intel19 compiler 77 75 ! 78 76 ! 4346 2019-12-18 11:55:56Z motisi 79 ! Introduction of wall_flags_total_0, which currently sets bits based on static 80 ! topographyinformation used in wall_flags_static_081 ! 77 ! Introduction of wall_flags_total_0, which currently sets bits based on static topography 78 ! information used in wall_flags_static_0 79 ! 82 80 ! 4329 2019-12-10 15:46:36Z motisi 83 81 ! Renamed wall_flags_0 to wall_flags_static_0 84 ! 82 ! 85 83 ! 4306 2019-11-25 12:04:48Z banzhafs 86 84 ! Corretion for r4304 commit … … 96 94 ! 97 95 ! 4273 2019-10-24 13:40:54Z monakurppa 98 ! Add logical switches nesting_chem and nesting_offline_chem (both .TRUE. 99 ! by default) 100 ! 96 ! Add logical switches nesting_chem and nesting_offline_chem (both .TRUE. by default) 97 ! 101 98 ! 4272 2019-10-23 15:18:57Z schwenkel 102 ! Further modularization of boundary conditions: moved boundary conditions to 103 ! respective modules 99 ! Further modularization of boundary conditions: moved boundary conditions to respective modules 104 100 ! 105 101 ! 4268 2019-10-17 11:29:38Z schwenkel 106 102 ! Moving module specific boundary conditions from time_integration to module 107 ! 103 ! 108 104 ! 4230 2019-09-11 13:58:14Z suehring 109 ! Bugfix, initialize mean profiles also in restart runs. Also initialize 110 ! array used for Runge-Kutta tendecies in restart runs.111 ! 105 ! Bugfix, initialize mean profiles also in restart runs. Also initialize array used for Runge-Kutta 106 ! tendecies in restart runs. 107 ! 112 108 ! 4227 2019-09-10 18:04:34Z gronemeier 113 109 ! implement new palm_date_time_mod 114 ! 110 ! 115 111 ! 4182 2019-08-22 15:20:23Z scharf 116 112 ! Corrected "Former revisions" section 117 ! 113 ! 118 114 ! 4167 2019-08-16 11:01:48Z suehring 119 ! Changed behaviour of masked output over surface to follow terrain and ignore 120 ! buildings (J.Resler, T.Gronemeier) 121 ! 122 ! 115 ! Changed behaviour of masked output over surface to follow terrain and ignore buildings 116 ! (J.Resler, T.Gronemeier) 117 ! 123 118 ! 4166 2019-08-16 07:54:21Z resler 124 119 ! Bugfix in decycling 125 ! 120 ! 126 121 ! 4115 2019-07-24 12:50:49Z suehring 127 122 ! Fix faulty IF statement in decycling initialization 128 ! 123 ! 129 124 ! 4110 2019-07-22 17:05:21Z suehring 130 ! - Decycling boundary conditions are only set at the ghost points not on the 131 ! prognostic grid points 132 ! - Allocation and initialization of special advection flags cs_advc_flags_s 133 ! used for chemistry. These are exclusively used for chemical species in 134 ! order to distinguish from the usually-used flags which might be different 135 ! when decycling is applied in combination with cyclic boundary conditions. 136 ! Moreover, cs_advc_flags_s considers extended zones around buildings where 137 ! first-order upwind scheme is applied for the horizontal advection terms, 138 ! in order to overcome high concentration peaks due to stationary numerical 139 ! oscillations caused by horizontal advection discretization. 140 ! 125 ! - Decycling boundary conditions are only set at the ghost points not on the prognostic grid points 126 ! - Allocation and initialization of special advection flags cs_advc_flags_s used for chemistry. 127 ! These are exclusively used for chemical species in order to distinguish from the usually-used 128 ! flags which might be different when decycling is applied in combination with cyclic boundary 129 ! conditions. 130 ! Moreover, cs_advc_flags_s considers extended zones around buildings where first-order upwind 131 ! scheme is applied for the horizontal advection terms, in order to overcome high concentration 132 ! peaks due to stationary numerical oscillations caused by horizontal advection discretization. 133 ! 141 134 ! 4109 2019-07-22 17:00:34Z suehring 142 ! Slightly revise setting of boundary conditions at horizontal walls, use 143 ! data-structure offsetindex instead of pre-calculate it for each facing144 ! 135 ! Slightly revise setting of boundary conditions at horizontal walls, use data-structure offset 136 ! index instead of pre-calculate it for each facing 137 ! 145 138 ! 4080 2019-07-09 18:17:37Z suehring 146 139 ! Restore accidantly removed limitation to positive values 147 ! 140 ! 148 141 ! 4079 2019-07-09 18:04:41Z suehring 149 ! Application of monotonic flux limiter for the vertical scalar advection 150 ! up to the topography top (only for the cache-optimized version at the 151 ! moment). 152 ! 142 ! Application of monotonic flux limiter for the vertical scalar advection up to the topography top 143 ! (only for the cache-optimized version at the moment). 144 ! 153 145 ! 4069 2019-07-01 14:05:51Z Giersch 154 ! Masked output running index mid has been introduced as a local variable to 155 ! avoid runtime error(Loop variable has been modified) in time_integration156 ! 146 ! Masked output running index mid has been introduced as a local variable to avoid runtime error 147 ! (Loop variable has been modified) in time_integration 148 ! 157 149 ! 4029 2019-06-14 14:04:35Z raasch 158 150 ! nest_chemistry option removed 159 ! 151 ! 160 152 ! 4004 2019-05-24 11:32:38Z suehring 161 ! in subroutine chem_parin check emiss_lod / mod_emis only 162 ! when emissions_anthropogenic is activatedin namelist (E.C. Chan)163 ! 153 ! in subroutine chem_parin check emiss_lod / mod_emis only when emissions_anthropogenic is activated 154 ! in namelist (E.C. Chan) 155 ! 164 156 ! 3968 2019-05-13 11:04:01Z suehring 165 ! - added "emiss_lod" which serves the same function as "mode_emis" 166 ! both will be synchronized with emiss_lod having pirority over 167 ! mode_emis (see informational messages) 157 ! - added "emiss_lod" which serves the same function as "mode_emis" both will be synchronized with 158 ! emiss_lod having pirority over mode_emis (see informational messages) 168 159 ! - modified existing error message and introduced new informational messages 169 160 ! - CM0436 - now also applies to invalid LOD settings 170 161 ! - CM0463 - emiss_lod take precedence in case of conflict with mod_emis 171 162 ! - CM0464 - emiss_lod valued assigned based on mode_emis if undefined 172 ! 163 ! 173 164 ! 3930 2019-04-24 14:57:18Z forkel 174 165 ! Changed chem_non_transport_physics to chem_non_advective_processes 175 ! 176 ! 166 ! 177 167 ! 3929 2019-04-24 12:52:08Z banzhafs 178 168 ! Correct/complete module_interface introduction for chemistry model … … 182 172 ! 3784 2019-03-05 14:16:20Z banzhafs 183 173 ! 2D output of emission fluxes 184 ! 174 ! 185 175 ! 3784 2019-03-05 14:16:20Z banzhafs 186 ! Bugfix, uncomment erroneous commented variable used for dry deposition. 187 ! Bugfix in 3D emission output. 188 ! 176 ! Bugfix, uncomment erroneous commented variable used for dry deposition. 177 ! Bugfix in 3D emission output. 178 ! 189 179 ! 3784 2019-03-05 14:16:20Z banzhafs 190 ! Changes related to global restructuring of location messages and introduction 180 ! Changes related to global restructuring of location messages and introduction 191 181 ! of additional debug messages 192 ! 182 ! 193 183 ! 3784 2019-03-05 14:16:20Z banzhafs 194 184 ! some formatting of the deposition code … … 196 186 ! 3784 2019-03-05 14:16:20Z banzhafs 197 187 ! some formatting 198 ! 188 ! 199 189 ! 3784 2019-03-05 14:16:20Z banzhafs 200 ! added cs_mech to USE chem_gasphase_mod 201 ! 190 ! added cs_mech to USE chem_gasphase_mod 191 ! 202 192 ! 3784 2019-03-05 14:16:20Z banzhafs 203 193 ! renamed get_mechanismname to get_mechanism_name 204 194 ! renamed do_emiss to emissions_anthropogenic and do_depo to deposition_dry (ecc) 205 ! 195 ! 206 196 ! 3784 2019-03-05 14:16:20Z banzhafs 207 197 ! Unused variables removed/taken care of 208 !209 198 ! 210 199 ! 3784 2019-03-05 14:16:20Z forkel 211 200 ! Replaced READ from unit 10 by CALL get_mechanismname also in chem_header 212 201 ! 213 !214 202 ! 3783 2019-03-05 13:23:50Z forkel 215 ! Removed forgotte write statements an some unused variables (did not touch the 216 ! parts related to deposition) 217 ! 218 ! 203 ! Removed forgotte write statements an some unused variables (did not touch the parts related to 204 ! deposition) 205 ! 219 206 ! 3780 2019-03-05 11:19:45Z forkel 220 207 ! Removed READ from unit 10, added CALL get_mechanismname 221 ! 222 ! 208 ! 223 209 ! 3767 2019-02-27 08:18:02Z raasch 224 210 ! unused variable for file index removed from rrd-subroutines parameter list 225 ! 211 ! 226 212 ! 3738 2019-02-12 17:00:45Z suehring 227 213 ! Clean-up debug prints 228 ! 214 ! 229 215 ! 3737 2019-02-12 16:57:06Z suehring 230 ! Enable mesoscale offline nesting for chemistry variables as well as 231 ! initialization of chemistryvia dynamic input file.232 ! 216 ! Enable mesoscale offline nesting for chemistry variables as well as initialization of chemistry 217 ! via dynamic input file. 218 ! 233 219 ! 3719 2019-02-06 13:10:18Z kanani 234 ! Resolved cpu logpoint overlap with all progn.equations, moved cpu_log call 235 ! to prognostic_equationsfor better overview236 ! 220 ! Resolved cpu logpoint overlap with all progn.equations, moved cpu_log call to prognostic_equations 221 ! for better overview 222 ! 237 223 ! 3700 2019-01-26 17:03:42Z knoop 238 224 ! Some interface calls moved to module_interface + cleanup 239 ! 225 ! 240 226 ! 3664 2019-01-09 14:00:37Z forkel 241 227 ! Replaced misplaced location message by @todo 242 ! 243 ! 228 ! 244 229 ! 3654 2019-01-07 16:31:57Z suehring 245 230 ! Disable misplaced location message 246 ! 231 ! 247 232 ! 3652 2019-01-07 15:29:59Z forkel 248 233 ! Checks added for chemistry mechanism, parameter chem_mechanism added (basit) 249 ! 234 ! 250 235 ! 2718 2018-01-02 08:49:38Z maronga 251 236 ! Initial revision 252 237 ! 253 ! 238 ! 254 239 ! 255 240 ! … … 263 248 ! 264 249 ! 265 !------------------------------------------------------------------------------ !250 !--------------------------------------------------------------------------------------------------! 266 251 ! Description: 267 252 ! ------------ … … 269 254 !> @todo Extend chem_species type by nspec and nvar as addititional elements (RF) 270 255 !> @todo Check possibility to reduce dimension of chem_species%conc from nspec to nvar (RF) 271 !> @todo Adjust chem_rrd_local to CASE structure of others modules. It is not 272 !> allowed to use the chemistry model in a precursor run and additionally 273 !> not using it in a main run 256 !> @todo Adjust chem_rrd_local to CASE structure of others modules. It is not allowed to use the 257 !> chemistry model in a precursor run and additionally not using it in a main run 274 258 !> @todo Implement turbulent inflow of chem spcs in inflow_turbulence. 275 259 !> @todo Separate boundary conditions for each chem spcs to be implemented 276 !> @todo Currently only total concentration are calculated. Resolved, parameterized 277 !> and chemistry fluxes although partially and some completely coded but278 !> are not operational/activated inthis version. bK.279 !> @todo slight differences in passive scalar and chem spcs when chem reactions 280 !> turned off. Need tobe fixed. bK260 !> @todo Currently only total concentration are calculated. Resolved, parameterized and chemistry 261 !> fluxes although partially and some completely coded but are not operational/activated in 262 !> this version. bK. 263 !> @todo slight differences in passive scalar and chem spcs when chem reactions turned off. Need to 264 !> be fixed. bK 281 265 !> @todo test nesting for chem spcs, was implemented by suehring (kanani) 282 266 !> @todo chemistry error messages 283 ! 284 !------------------------------------------------------------------------------ !267 ! 268 !--------------------------------------------------------------------------------------------------! 285 269 286 270 MODULE chemistry_model_mod … … 313 297 314 298 USE control_parameters, & 315 ONLY: bc_lr_cyc, bc_ns_cyc,&299 ONLY: air_chemistry, & 316 300 bc_dirichlet_l, & 317 301 bc_dirichlet_n, & … … 319 303 bc_dirichlet_s, & 320 304 bc_radiation_l, & 305 bc_lr_cyc, & 306 bc_ns_cyc, & 321 307 bc_radiation_n, & 322 308 bc_radiation_r, & 323 309 bc_radiation_s, & 324 310 debug_output, & 325 dt_3d, humidity, initializing_actions, message_string, & 326 omega, tsc, intermediate_timestep_count, intermediate_timestep_count_max, & 311 dt_3d, & 312 humidity, & 313 initializing_actions, & 314 intermediate_timestep_count, & 315 intermediate_timestep_count_max, & 327 316 max_pr_user, & 317 message_string, & 328 318 monotonic_limiter_z, & 319 omega, & 329 320 restart_data_format_output, & 330 321 scalar_advec, & 331 timestep_scheme, use_prescribed_profile_data, ws_scheme_sca, air_chemistry 322 timestep_scheme, & 323 tsc, & 324 use_prescribed_profile_data, & 325 ws_scheme_sca 332 326 333 327 USE arrays_3d, & … … 359 353 SAVE 360 354 355 INTEGER, DIMENSION(nkppctrl) :: icntrl !< 20 integer parameters for fine tuning KPP code 356 357 REAL(kind=wp), PUBLIC :: cs_time_step = 0._wp 358 359 REAL(kind=wp), DIMENSION(nkppctrl) :: rcntrl !< 20 real parameters for fine tuning of KPP code 360 !< (e.g starting internal timestep of solver) 361 361 362 REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: spec_conc_1 !< pointer for swapping of timelevels for conc 362 363 REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: spec_conc_2 !< pointer for swapping of timelevels for conc 363 364 REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: spec_conc_3 !< pointer for swapping of timelevels for conc 364 REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: freq_1 !< pointer for phtolysis frequncies 365 REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: freq_1 !< pointer for phtolysis frequncies 365 366 !< (only 1 timelevel required) 366 INTEGER, DIMENSION(nkppctrl) :: icntrl !< 20 integer parameters for fine tuning KPP code367 367 !< (e.g. solver type) 368 REAL(kind=wp), DIMENSION(nkppctrl) :: rcntrl !< 20 real parameters for fine tuning of KPP code 369 !< (e.g starting internal timestep of solver) 370 371 REAL(kind=wp), PUBLIC :: cs_time_step = 0._wp 368 372 369 373 370 ! 374 371 !-- Parameter needed for Deposition calculation using DEPAC model (van Zanten et al., 2010) 375 ! 376 INTEGER(iwp), PARAMETER :: nlu_dep = 15 !< Number of DEPAC landuse classes (lu's) 377 INTEGER(iwp), PARAMETER :: ncmp = 10 !< Number of DEPAC gas components 378 INTEGER(iwp), PARAMETER :: nposp = 69 !< Number of possible species for deposition 379 ! 380 !-- DEPAC landuse classes as defined in LOTOS-EUROS model v2.1 381 INTEGER(iwp) :: ilu_grass = 1 382 INTEGER(iwp) :: ilu_arable = 2 383 INTEGER(iwp) :: ilu_permanent_crops = 3 384 INTEGER(iwp) :: ilu_coniferous_forest = 4 385 INTEGER(iwp) :: ilu_deciduous_forest = 5 386 INTEGER(iwp) :: ilu_water_sea = 6 387 INTEGER(iwp) :: ilu_urban = 7 388 INTEGER(iwp) :: ilu_other = 8 389 INTEGER(iwp) :: ilu_desert = 9 390 INTEGER(iwp) :: ilu_ice = 10 391 INTEGER(iwp) :: ilu_savanna = 11 392 INTEGER(iwp) :: ilu_tropical_forest = 12 393 INTEGER(iwp) :: ilu_water_inland = 13 394 INTEGER(iwp) :: ilu_mediterrean_scrub = 14 395 INTEGER(iwp) :: ilu_semi_natural_veg = 15 372 INTEGER(iwp), PARAMETER :: nlu_dep = 15 !< Number of DEPAC landuse classes (lu's) 373 INTEGER(iwp), PARAMETER :: ncmp = 10 !< Number of DEPAC gas components 374 INTEGER(iwp), PARAMETER :: nposp = 69 !< Number of possible species for deposition 375 ! 376 !-- DEPAC landuse classes as defined in LOTOS-EUROS model v2.1 377 INTEGER(iwp) :: ilu_grass = 1 378 INTEGER(iwp) :: ilu_arable = 2 379 INTEGER(iwp) :: ilu_permanent_crops = 3 380 INTEGER(iwp) :: ilu_coniferous_forest = 4 381 INTEGER(iwp) :: ilu_deciduous_forest = 5 382 INTEGER(iwp) :: ilu_water_sea = 6 383 INTEGER(iwp) :: ilu_urban = 7 384 INTEGER(iwp) :: ilu_other = 8 385 INTEGER(iwp) :: ilu_desert = 9 386 INTEGER(iwp) :: ilu_ice = 10 387 INTEGER(iwp) :: ilu_savanna = 11 388 INTEGER(iwp) :: ilu_tropical_forest = 12 389 INTEGER(iwp) :: ilu_water_inland = 13 390 INTEGER(iwp) :: ilu_mediterrean_scrub = 14 391 INTEGER(iwp) :: ilu_semi_natural_veg = 15 396 392 397 393 ! … … 405 401 ! 406 402 !-- Set alpha for f_light (4.57 is conversion factor from 1./(mumol m-2 s-1) to W m-2 407 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: alpha = (/ 0.009, 0.009, 0.009, 0.006, 0.006, -999., -999., 0.009, -999.,&408 -999., 0.009, 0.006, -999., 0.009, 0.008/)*4.57403 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: alpha = (/ 0.009, 0.009, 0.009, 0.006, 0.006, & 404 -999.0, -999., 0.009, -999.0, -999.0, 0.009, 0.006, -999.0, 0.009, 0.008 /)*4.57 409 405 ! 410 406 !-- Set temperatures per land use for f_temp 411 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: tmin = (/ 12.0, 12.0, 12.0, 0.0, 0.0, -999., -999., 12.0, -999., -999.,&412 12.0, 0.0, -999., 12.0, 8.0/)413 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: topt = (/ 26.0, 26.0, 26.0, 18.0, 20.0, -999. , -999., 26.0, -999., -999.,&414 26.0, 20.0, -999., 26.0, 24.0 /)415 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: tmax = (/ 40.0, 40.0, 40.0, 36.0, 35.0, -999. , -999., 40.0, -999., -999.,&416 40.0, 35.0, -999., 40.0, 39.0 /)407 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: tmin = (/ 12.0, 12.0, 12.0, 0.0, 0.0, -999.0, & 408 -999.0, 12.0, -999.0, -999.0, 12.0, 0.0, -999.0, 12.0, 8.0/) 409 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: topt = (/ 26.0, 26.0, 26.0, 18.0, 20.0, -999.0, & 410 -999.0, 26.0, -999.0, -999.0, 26.0, 20.0, -999.0, 26.0, 24.0 /) 411 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: tmax = (/ 40.0, 40.0, 40.0, 36.0, 35.0, -999.0, & 412 -999.0, 40.0, -999.0, -999.0, 40.0, 35.0, -999.0, 40.0, 39.0 /) 417 413 ! 418 414 !-- Set f_min: 419 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: f_min = (/ 0.01, 0.01, 0.01, 0.1, 0.1, -999. , -999., 0.01, -999., -999., 0.01,&420 0.1, -999., 0.01, 0.04/)415 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: f_min = (/ 0.01, 0.01, 0.01, 0.1, 0.1, -999.0, & 416 -999.0, 0.01, -999.0, -999.0, 0.01, 0.1, -999.0, 0.01, 0.04/) 421 417 422 418 ! 423 419 !-- Set maximal conductance (m/s) 424 420 !-- (R T/P) = 1/41000 mmol/m3 is given for 20 deg C to go from mmol O3/m2/s to m/s 425 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: g_max = (/ 270. , 300., 300., 140., 150., -999., -999., 270., -999., -999., &426 270., 150., -999., 300., 422./)/41000.421 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: g_max = (/ 270.0, 300.0, 300.0, 140.0, 150.0, & 422 -999.0, -999.0, 270.0, -999.0, -999.0, 270.0, 150.0, -999.0, 300.0, 422.0 /) / 41000.0 427 423 ! 428 424 !-- Set max, min for vapour pressure deficit vpd 429 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: vpd_max = (/ 1.3, 0.9, 0.9, 0.5, 1.0, -999., -999., 1.3, -999., -999., 1.3, &430 1.0, -999., 0.9, 2.8/)431 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: vpd_min = (/ 3.0, 2.8, 2.8, 3.0, 3.25, -999., -999., 3.0, -999., -999., 3.0, &432 3.25, -999., 2.8, 4.5/)425 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: vpd_max = (/ 1.3, 0.9, 0.9, 0.5, 1.0, -999.0, & 426 -999.0, 1.3, -999.0, -999.0, 1.3, 1.0, -999.0, 0.9, 2.8/) 427 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: vpd_min = (/ 3.0, 2.8, 2.8, 3.0, 3.25, -999.0, & 428 -999.0, 3.0, -999.0, -999.0, 3.0, 3.25, -999.0, 2.8, 4.5/) 433 429 434 430 PUBLIC nreact … … 436 432 PUBLIC nvar !< number of variable gas phase chemical species (nvar <= nspec) 437 433 PUBLIC spc_names !< names of gas phase chemical species (come from KPP) (come from KPP) 438 PUBLIC spec_conc_2 439 ! 434 PUBLIC spec_conc_2 435 ! 440 436 !-- Interface section 441 437 INTERFACE chem_3d_data_averaging 442 MODULE PROCEDURE chem_3d_data_averaging 438 MODULE PROCEDURE chem_3d_data_averaging 443 439 END INTERFACE chem_3d_data_averaging 444 440 … … 508 504 MODULE PROCEDURE chem_non_advective_processes_ij 509 505 END INTERFACE chem_non_advective_processes 510 506 511 507 INTERFACE chem_exchange_horiz_bounds 512 508 MODULE PROCEDURE chem_exchange_horiz_bounds 513 END INTERFACE chem_exchange_horiz_bounds 509 END INTERFACE chem_exchange_horiz_bounds 514 510 515 511 INTERFACE chem_prognostic_equations … … 532 528 533 529 INTERFACE chem_wrd_local 534 MODULE PROCEDURE chem_wrd_local 530 MODULE PROCEDURE chem_wrd_local 535 531 END INTERFACE chem_wrd_local 536 532 537 533 INTERFACE chem_depo 538 MODULE PROCEDURE chem_depo 534 MODULE PROCEDURE chem_depo 539 535 END INTERFACE chem_depo 540 536 541 537 INTERFACE drydepos_gas_depac 542 MODULE PROCEDURE drydepos_gas_depac 538 MODULE PROCEDURE drydepos_gas_depac 543 539 END INTERFACE drydepos_gas_depac 544 540 545 541 INTERFACE rc_special 546 MODULE PROCEDURE rc_special 542 MODULE PROCEDURE rc_special 547 543 END INTERFACE rc_special 548 544 549 545 INTERFACE rc_gw 550 MODULE PROCEDURE rc_gw 546 MODULE PROCEDURE rc_gw 551 547 END INTERFACE rc_gw 552 548 553 INTERFACE rw_so2 554 MODULE PROCEDURE rw_so2 549 INTERFACE rw_so2 550 MODULE PROCEDURE rw_so2 555 551 END INTERFACE rw_so2 556 552 557 553 INTERFACE rw_nh3_sutton 558 MODULE PROCEDURE rw_nh3_sutton 554 MODULE PROCEDURE rw_nh3_sutton 559 555 END INTERFACE rw_nh3_sutton 560 556 561 557 INTERFACE rw_constant 562 MODULE PROCEDURE rw_constant 558 MODULE PROCEDURE rw_constant 563 559 END INTERFACE rw_constant 564 560 565 561 INTERFACE rc_gstom 566 MODULE PROCEDURE rc_gstom 562 MODULE PROCEDURE rc_gstom 567 563 END INTERFACE rc_gstom 568 564 569 565 INTERFACE rc_gstom_emb 570 MODULE PROCEDURE rc_gstom_emb 566 MODULE PROCEDURE rc_gstom_emb 571 567 END INTERFACE rc_gstom_emb 572 568 573 569 INTERFACE par_dir_diff 574 MODULE PROCEDURE par_dir_diff 570 MODULE PROCEDURE par_dir_diff 575 571 END INTERFACE par_dir_diff 576 572 577 573 INTERFACE rc_get_vpd 578 MODULE PROCEDURE rc_get_vpd 574 MODULE PROCEDURE rc_get_vpd 579 575 END INTERFACE rc_get_vpd 580 576 581 577 INTERFACE rc_gsoil_eff 582 MODULE PROCEDURE rc_gsoil_eff 578 MODULE PROCEDURE rc_gsoil_eff 583 579 END INTERFACE rc_gsoil_eff 584 580 585 581 INTERFACE rc_rinc 586 MODULE PROCEDURE rc_rinc 582 MODULE PROCEDURE rc_rinc 587 583 END INTERFACE rc_rinc 588 584 589 585 INTERFACE rc_rctot 590 MODULE PROCEDURE rc_rctot 586 MODULE PROCEDURE rc_rctot 591 587 END INTERFACE rc_rctot 592 588 593 589 INTERFACE drydepo_aero_zhang_vd 594 MODULE PROCEDURE drydepo_aero_zhang_vd 590 MODULE PROCEDURE drydepo_aero_zhang_vd 595 591 END INTERFACE drydepo_aero_zhang_vd 596 592 … … 612 608 613 609 614 !------------------------------------------------------------------------------ !610 !--------------------------------------------------------------------------------------------------! 615 611 ! Description: 616 612 ! ------------ 617 !> Subroutine for averaging 3D data of chemical species. Due to the fact that 618 !> the averaged chem arrays are allocated in chem_init, no if-query concerning 619 !> the allocation is required (in any mode). Attention: If you just specify an 620 !> averaged output quantity in the _p3dr file during restarts the first output 621 !> includes the time between the beginning of the restart run and the first 622 !> output time (not necessarily the whole averaging_interval you have 623 !> specified in your _p3d/_p3dr file ) 624 !------------------------------------------------------------------------------! 613 !> Subroutine for averaging 3D data of chemical species. Due to the fact that the averaged chem 614 !> arrays are allocated in chem_init, no if-query concerning the allocation is required (in any 615 !> mode). Attention: If you just specify an averaged output quantity in the _p3dr file during 616 !> restarts the first output includes the time between the beginning of the restart run and the 617 !> first output time (not necessarily the whole averaging_interval you have specified in your 618 !> _p3d/_p3dr file ). 619 !--------------------------------------------------------------------------------------------------! 625 620 SUBROUTINE chem_3d_data_averaging( mode, variable ) 626 621 627 622 USE control_parameters 628 623 629 USE exchange_horiz_mod, &624 USE exchange_horiz_mod, & 630 625 ONLY: exchange_horiz_2d 631 626 632 627 633 CHARACTER (LEN=*) :: mode !< 634 CHARACTER (LEN=*) :: variable !< 628 CHARACTER (LEN=*) :: mode !< 629 CHARACTER (LEN=*) :: variable !< 635 630 636 631 LOGICAL :: match_def !< flag indicating default-type surface … … 641 636 INTEGER(iwp) :: j !< grid index y direction 642 637 INTEGER(iwp) :: k !< grid index z direction 638 INTEGER(iwp) :: lsp !< running index for chem spcs 643 639 INTEGER(iwp) :: m !< running index surface type 644 INTEGER(iwp) :: lsp !< running index for chem spcs 645 646 IF ( (variable(1:3) == 'kc_' .OR. variable(1:3) == 'em_') ) THEN 640 641 IF ( ( variable(1:3) == 'kc_' .OR. variable(1:3) == 'em_' ) ) THEN 647 642 648 643 IF ( mode == 'allocate' ) THEN 649 644 650 645 DO lsp = 1, nspec 651 IF ( TRIM( variable(1:3) ) == 'kc_' .AND.&652 TRIM( variable(4:) ) == TRIM( chem_species(lsp)%name ) ) THEN646 IF ( TRIM( variable(1:3) ) == 'kc_' .AND. & 647 TRIM( variable(4:) ) == TRIM( chem_species(lsp)%name ) ) THEN 653 648 IF ( .NOT. ALLOCATED( chem_species(lsp)%conc_av ) ) THEN 654 649 ALLOCATE( chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) … … 661 656 662 657 DO lsp = 1, nspec 663 IF ( TRIM( variable(1:3) ) == 'kc_' .AND.&664 TRIM( variable(4:) ) == TRIM( chem_species(lsp)%name ) ) THEN658 IF ( TRIM( variable(1:3) ) == 'kc_' .AND. & 659 TRIM( variable(4:) ) == TRIM( chem_species(lsp)%name ) ) THEN 665 660 DO i = nxlg, nxrg 666 661 DO j = nysg, nyng 667 662 DO k = nzb, nzt+1 668 chem_species(lsp)%conc_av(k,j,i) = & 669 chem_species(lsp)%conc_av(k,j,i) + & 670 chem_species(lsp)%conc(k,j,i) 663 chem_species(lsp)%conc_av(k,j,i) = chem_species(lsp)%conc_av(k,j,i) + & 664 chem_species(lsp)%conc(k,j,i) 671 665 ENDDO 672 666 ENDDO … … 675 669 DO i = nxl, nxr 676 670 DO j = nys, nyn 677 match_def = surf_def_h(0)%start_index(j,i) <= & 678 surf_def_h(0)%end_index(j,i) 679 match_lsm = surf_lsm_h%start_index(j,i) <= & 680 surf_lsm_h%end_index(j,i) 681 match_usm = surf_usm_h%start_index(j,i) <= & 682 surf_usm_h%end_index(j,i) 671 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 672 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 673 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 683 674 684 675 IF ( match_def ) THEN 685 676 m = surf_def_h(0)%end_index(j,i) 686 chem_species(lsp)%cssws_av(j,i) = & 687 chem_species(lsp)%cssws_av(j,i) + & 688 surf_def_h(0)%cssws(lsp,m) 677 chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) + & 678 surf_def_h(0)%cssws(lsp,m) 689 679 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 690 680 m = surf_lsm_h%end_index(j,i) 691 chem_species(lsp)%cssws_av(j,i) = & 692 chem_species(lsp)%cssws_av(j,i) + & 693 surf_lsm_h%cssws(lsp,m) 681 chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) + & 682 surf_lsm_h%cssws(lsp,m) 694 683 ELSEIF ( match_usm ) THEN 695 684 m = surf_usm_h%end_index(j,i) 696 chem_species(lsp)%cssws_av(j,i) = & 697 chem_species(lsp)%cssws_av(j,i) + & 698 surf_usm_h%cssws(lsp,m) 685 chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) + & 686 surf_usm_h%cssws(lsp,m) 699 687 ENDIF 700 688 ENDDO … … 706 694 707 695 DO lsp = 1, nspec 708 IF ( TRIM( variable(1:3) ) == 'kc_' .AND.&709 TRIM( variable(4:) ) == TRIM( chem_species(lsp)%name ) ) THEN696 IF ( TRIM( variable(1:3) ) == 'kc_' .AND. & 697 TRIM( variable(4:) ) == TRIM( chem_species(lsp)%name ) ) THEN 710 698 DO i = nxlg, nxrg 711 699 DO j = nysg, nyng 712 700 DO k = nzb, nzt+1 713 chem_species(lsp)%conc_av(k,j,i) = & 714 chem_species(lsp)%conc_av(k,j,i) / & 715 REAL( average_count_3d, KIND=wp ) 701 chem_species(lsp)%conc_av(k,j,i) = chem_species(lsp)%conc_av(k,j,i) / & 702 REAL( average_count_3d, KIND = wp ) 716 703 ENDDO 717 704 ENDDO … … 721 708 DO i = nxlg, nxrg 722 709 DO j = nysg, nyng 723 chem_species(lsp)%cssws_av(j,i) = 724 chem_species(lsp)%cssws_av(j,i) / REAL( average_count_3d, KIND=wp )710 chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) / & 711 REAL( average_count_3d, KIND = wp ) 725 712 ENDDO 726 713 ENDDO … … 734 721 END SUBROUTINE chem_3d_data_averaging 735 722 736 737 !------------------------------------------------------------------------------ !723 724 !--------------------------------------------------------------------------------------------------! 738 725 ! Description: 739 726 ! ------------ 740 727 !> Subroutine to initialize and set all boundary conditions for chemical species 741 !------------------------------------------------------------------------------ !728 !--------------------------------------------------------------------------------------------------! 742 729 SUBROUTINE chem_boundary_conditions( horizontal_conditions_only ) 743 730 744 USE arrays_3d, &731 USE arrays_3d, & 745 732 ONLY: dzu 746 733 747 USE surface_mod, &748 ONLY: bc_h 734 USE surface_mod, & 735 ONLY: bc_h 749 736 750 737 INTEGER(iwp) :: i !< grid index x direction. … … 752 739 INTEGER(iwp) :: k !< grid index z direction. 753 740 INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls. 741 INTEGER(iwp) :: lsp !< running index for chem spcs. 754 742 INTEGER(iwp) :: m !< running index surface elements. 755 INTEGER(iwp) :: lsp !< running index for chem spcs.756 743 757 744 LOGICAL, OPTIONAL :: horizontal_conditions_only !< switch to set horizontal bc only … … 770 757 j = bc_h(l)%j(m) 771 758 k = bc_h(l)%k(m) 772 chem_species(lsp)%conc_p(k+bc_h(l)%koff,j,i) = &773 chem_species(lsp)%conc(k+bc_h(l)%koff,j,i)759 chem_species(lsp)%conc_p(k+bc_h(l)%koff,j,i) = & 760 chem_species(lsp)%conc(k+bc_h(l)%koff,j,i) 774 761 ENDDO 775 762 ENDDO … … 785 772 j = bc_h(l)%j(m) 786 773 k = bc_h(l)%k(m) 787 chem_species(lsp)%conc_p(k+bc_h(l)%koff,j,i) = & 788 chem_species(lsp)%conc_p(k,j,i) 774 chem_species(lsp)%conc_p(k+bc_h(l)%koff,j,i) = chem_species(lsp)%conc_p(k,j,i) 789 775 ENDDO 790 776 ENDDO 791 777 ENDIF 792 778 793 ENDDO ! end lsp loop 779 ENDDO ! end lsp loop 794 780 795 781 ! … … 798 784 !> already runs over all species? (Siggi) 799 785 DO lsp = 1, nspec 800 IF ( ibc_cs_t == 0 ) THEN 786 IF ( ibc_cs_t == 0 ) THEN 801 787 chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc(nzt+1,:,:) 802 788 ELSEIF ( ibc_cs_t == 1 ) THEN … … 904 890 ! 905 891 !-- Lateral Neumann booundary conditions for timelevel t. 906 !-- This branch is executed when routine is called after the non-advective processes / 907 !-- before theprognostic equations.892 !-- This branch is executed when routine is called after the non-advective processes / before the 893 !-- prognostic equations. 908 894 IF ( bc_radiation_cs_s ) THEN 909 895 DO lsp = 1, nspec … … 998 984 999 985 1000 !------------------------------------------------------------------------------ !986 !--------------------------------------------------------------------------------------------------! 1001 987 ! Description: 1002 988 ! ------------ 1003 989 !> Subroutine for checking data output for chemical species 1004 !------------------------------------------------------------------------------ !990 !--------------------------------------------------------------------------------------------------! 1005 991 SUBROUTINE chem_check_data_output( var, unit, i, ilen, k ) 1006 992 … … 1010 996 1011 997 INTEGER(iwp) :: i 998 INTEGER(iwp) :: ilen 1012 999 INTEGER(iwp) :: lsp 1013 INTEGER(iwp) :: ilen1014 1000 INTEGER(iwp) :: k 1015 1001 … … 1026 1012 IF ( TRIM( var(1:3) ) == 'em_' ) THEN 1027 1013 DO lsp=1,nspec 1028 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) ) THEN1014 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) ) THEN 1029 1015 unit = 'mol m-2 s-1' 1030 1016 ENDIF 1031 1017 ! 1032 !-- It is possible to plant PM10 and PM25 into the gasphase chemistry code 1033 !-- as passive species (e.g. 'passive' in GASPHASE_PREPROC/mechanisms):1034 !-- set unit to micrograms per m**3 for PM10and PM25 (PM2.5)1018 !-- It is possible to plant PM10 and PM25 into the gasphase chemistry code as passive species 1019 !-- (e.g. 'passive' in GASPHASE_PREPROC/mechanisms): set unit to micrograms per m**3 for PM10 1020 !-- and PM25 (PM2.5) 1035 1021 IF (spec_name(1:2) == 'PM') THEN 1036 1022 unit = 'kg m-2 s-1' … … 1041 1027 1042 1028 DO lsp=1,nspec 1043 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) ) THEN1029 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) ) THEN 1044 1030 unit = 'ppm' 1045 1031 ENDIF 1046 1032 ! 1047 !-- It is possible to plant PM10 and PM25 into the gasphase chemistry code1048 !-- as passive species (e.g. 'passive' in GASPHASE_PREPROC/mechanisms):1049 !-- set unit to kilograms per m**3 for PM10and PM25 (PM2.5)1050 IF (spec_name(1:2) == 'PM') THEN 1033 !-- It is possible to plant PM10 and PM25 into the gasphase chemistry code as passive species 1034 !-- (e.g. 'passive' in GASPHASE_PREPROC/mechanisms): set unit to kilograms per m**3 for PM10 1035 !-- and PM25 (PM2.5) 1036 IF (spec_name(1:2) == 'PM') THEN 1051 1037 unit = 'kg m-3' 1052 1038 ENDIF … … 1054 1040 1055 1041 DO lsp=1,nphot 1056 IF ( TRIM( spec_name ) == TRIM( phot_frequen(lsp)%name ) ) THEN1042 IF ( TRIM( spec_name ) == TRIM( phot_frequen(lsp)%name ) ) THEN 1057 1043 unit = 'sec-1' 1058 1044 ENDIF … … 1065 1051 1066 1052 1067 !------------------------------------------------------------------------------ !1053 !--------------------------------------------------------------------------------------------------! 1068 1054 ! Description: 1069 1055 ! ------------ 1070 1056 !> Subroutine for checking data output of profiles for chemistry model 1071 !------------------------------------------------------------------------------ !1057 !--------------------------------------------------------------------------------------------------! 1072 1058 SUBROUTINE chem_check_data_output_pr( variable, var_count, unit, dopr_unit ) 1073 1059 1074 1060 USE arrays_3d 1075 1061 1076 USE control_parameters, &1062 USE control_parameters, & 1077 1063 ONLY: data_output_pr, message_string 1078 1064 … … 1082 1068 1083 1069 1084 CHARACTER (LEN=*) :: unit !<1085 CHARACTER (LEN=*) :: variable !<1086 CHARACTER (LEN=*) :: dopr_unit1070 CHARACTER (LEN=*) :: unit !< 1071 CHARACTER (LEN=*) :: variable !< 1072 CHARACTER (LEN=*) :: dopr_unit 1087 1073 CHARACTER (LEN=16) :: spec_name 1088 1074 … … 1090 1076 1091 1077 1092 spec_name = TRIM( variable(4:) ) 1093 1094 IF ( .NOT. air_chemistry ) THEN 1095 message_string = 'data_output_pr = ' // & 1096 TRIM( data_output_pr(var_count) ) // ' is not imp' // & 1097 'lemented for air_chemistry = .FALSE.' 1098 CALL message( 'chem_check_parameters', 'CM0433', 1, 2, 0, 6, 0 ) 1078 spec_name = TRIM( variable(4:) ) 1079 1080 IF ( .NOT. air_chemistry ) THEN 1081 message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // & 1082 ' is not imp' // 'lemented for air_chemistry = .FALSE.' 1083 CALL message( 'chem_check_parameters', 'CM0433', 1, 2, 0, 6, 0 ) 1099 1084 1100 1085 ELSE 1101 1086 DO lsp = 1, nspec 1102 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) ) THEN1087 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) ) THEN 1103 1088 cs_pr_count = cs_pr_count+1 1104 1089 cs_pr_index(cs_pr_count) = lsp 1105 dopr_index(var_count) = pr_palm+cs_pr_count 1090 dopr_index(var_count) = pr_palm+cs_pr_count 1106 1091 dopr_unit = 'ppm' 1107 IF ( spec_name(1:2) == 'PM') THEN1092 IF ( spec_name(1:2) == 'PM') THEN 1108 1093 dopr_unit = 'kg m-3' 1109 1094 ENDIF 1110 1095 hom(:,2, dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) 1111 unit = dopr_unit 1096 unit = dopr_unit 1112 1097 ENDIF 1113 1098 ENDDO … … 1117 1102 1118 1103 1119 !------------------------------------------------------------------------------ !1104 !--------------------------------------------------------------------------------------------------! 1120 1105 ! Description: 1121 1106 ! ------------ 1122 1107 !> Check parameters routine for chemistry_model_mod 1123 !------------------------------------------------------------------------------ !1108 !--------------------------------------------------------------------------------------------------! 1124 1109 SUBROUTINE chem_check_parameters 1125 1110 … … 1127 1112 ONLY: bc_lr, bc_ns 1128 1113 1114 INTEGER (iwp) :: lsp !< running index for chem spcs. 1115 INTEGER (iwp) :: lsp_usr !< running index for user defined chem spcs 1116 1129 1117 LOGICAL :: found 1130 INTEGER (iwp) :: lsp_usr !< running index for user defined chem spcs 1131 INTEGER (iwp) :: lsp !< running index for chem spcs. 1132 ! 1133 !-- check for chemical reactions status 1118 1119 ! 1120 !-- Check for chemical reactions status 1134 1121 IF ( chem_gasphase_on ) THEN 1135 1122 message_string = 'Chemical reactions: ON' … … 1140 1127 ENDIF 1141 1128 ! 1142 !-- check for chemistry time-step1129 !-- Check for chemistry time-step 1143 1130 IF ( call_chem_at_all_substeps ) THEN 1144 1131 message_string = 'Chemistry is calculated at all meteorology time-step' … … 1149 1136 ENDIF 1150 1137 ! 1151 !-- check for photolysis scheme1138 !-- Check for photolysis scheme 1152 1139 IF ( (photolysis_scheme /= 'simple') .AND. (photolysis_scheme /= 'constant') ) THEN 1153 1140 message_string = 'Incorrect photolysis scheme selected, please check spelling' … … 1155 1142 ENDIF 1156 1143 ! 1157 !-- check for chemical mechanism used1144 !-- Check for chemical mechanism used 1158 1145 CALL get_mechanism_name 1159 1146 IF ( chem_mechanism /= TRIM( cs_mech ) ) THEN 1160 message_string = 'Incorrect chemistry mechanism selected, check spelling in namelist and/or chem_gasphase_mod' 1147 message_string = & 1148 'Incorrect chemistry mechanism selected, check spelling in namelist and/or chem_gasphase_mod' 1161 1149 CALL message( 'chem_check_parameters', 'CM0462', 1, 2, 0, 6, 0 ) 1162 1150 ENDIF … … 1252 1240 ! 1253 1241 !-- Cyclic conditions must be set identically at opposing boundaries 1254 IF ( ( bc_cs_l == 'cyclic' .AND. bc_cs_r /= 'cyclic' ) .OR. &1242 IF ( ( bc_cs_l == 'cyclic' .AND. bc_cs_r /= 'cyclic' ) .OR. & 1255 1243 ( bc_cs_r == 'cyclic' .AND. bc_cs_l /= 'cyclic' ) ) THEN 1256 1244 message_string = 'boundary conditions bc_cs_l and bc_cs_r must both be cyclic or non-cyclic' 1257 1245 CALL message( 'chem_check_parameters','PA0716', 1, 2, 0, 6, 0 ) 1258 1246 ENDIF 1259 IF ( ( bc_cs_n == 'cyclic' .AND. bc_cs_s /= 'cyclic' ) .OR. &1247 IF ( ( bc_cs_n == 'cyclic' .AND. bc_cs_s /= 'cyclic' ) .OR. & 1260 1248 ( bc_cs_s == 'cyclic' .AND. bc_cs_n /= 'cyclic' ) ) THEN 1261 1249 message_string = 'boundary conditions bc_cs_n and bc_cs_s must both be cyclic or non-cyclic' … … 1298 1286 CALL chem_init_internal 1299 1287 ! 1300 !-- check for initial chem species input1288 !-- Check for initial chem species input 1301 1289 lsp_usr = 1 1302 1290 lsp = 1 … … 1307 1295 found = .TRUE. 1308 1296 EXIT 1309 ENDIF 1297 ENDIF 1310 1298 ENDDO 1311 1299 IF ( .NOT. found ) THEN … … 1317 1305 ENDDO 1318 1306 ! 1319 !-- check for surface emission flux chem species1307 !-- Check for surface emission flux chem species 1320 1308 lsp_usr = 1 1321 1309 lsp = 1 … … 1326 1314 found = .TRUE. 1327 1315 EXIT 1328 ENDIF 1316 ENDIF 1329 1317 ENDDO 1330 1318 IF ( .NOT. found ) THEN … … 1339 1327 1340 1328 1341 !------------------------------------------------------------------------------ !1329 !--------------------------------------------------------------------------------------------------! 1342 1330 ! Description: 1343 1331 ! ------------ 1344 1332 !> Subroutine defining 2D output variables for chemical species 1345 1333 !> @todo: Remove "mode" from argument list, not used. 1346 !------------------------------------------------------------------------------ !1347 SUBROUTINE chem_data_output_2d( av, variable, found, grid, mode, local_pf, 1348 two_d, nzb_do, nzt_do,fill_value )1334 !--------------------------------------------------------------------------------------------------! 1335 SUBROUTINE chem_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do, & 1336 fill_value ) 1349 1337 1350 1338 1351 1339 CHARACTER (LEN=*) :: grid !< 1352 CHARACTER (LEN=*) :: mode !< 1353 CHARACTER (LEN=*) :: variable !< 1354 INTEGER(iwp) :: av !< flag to control data output of instantaneous or time-averaged data 1340 CHARACTER (LEN=*) :: mode !< 1341 CHARACTER (LEN=*) :: variable !< 1342 1343 INTEGER(iwp) :: av !< flag to control data output of instantaneous or 1344 !< time-averaged data 1355 1345 INTEGER(iwp) :: nzb_do !< lower limit of the domain (usually nzb) 1356 1346 INTEGER(iwp) :: nzt_do !< upper limit of the domain (usually nzt+1) 1357 LOGICAL :: found !< 1358 LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections) 1359 REAL(wp) :: fill_value 1360 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf 1347 1348 LOGICAL :: found !< 1349 LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross 1350 !< sections) 1351 1352 REAL(wp) :: fill_value 1353 1354 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf 1361 1355 1362 1356 ! … … 1378 1372 spec_name = TRIM( variable(4:char_len-3) ) 1379 1373 ! 1380 !-- Output of emission values, i.e. surface fluxes cssws. 1374 !-- Output of emission values, i.e. surface fluxes cssws. 1381 1375 IF ( variable(1:3) == 'em_' ) THEN 1382 1376 … … 1386 1380 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name) ) THEN 1387 1381 ! 1388 !-- No average output for now. 1382 !-- No average output for now. 1389 1383 DO m = 1, surf_lsm_h%ns 1390 local_pf(surf_lsm_h%i(m),surf_lsm_h%j(m),nzb+1) = &1391 local_pf(surf_lsm_h%i(m),surf_lsm_h%j(m),nzb+1)&1392 + surf_lsm_h%cssws(lsp,m)1384 local_pf(surf_lsm_h%i(m),surf_lsm_h%j(m),nzb+1) = & 1385 local_pf(surf_lsm_h%i(m),surf_lsm_h%j(m),nzb+1) & 1386 + surf_lsm_h%cssws(lsp,m) 1393 1387 ENDDO 1394 1388 DO m = 1, surf_usm_h%ns 1395 local_pf(surf_usm_h%i(m),surf_usm_h%j(m),nzb+1) = &1396 local_pf(surf_usm_h%i(m),surf_usm_h%j(m),nzb+1)&1397 + surf_usm_h%cssws(lsp,m)1389 local_pf(surf_usm_h%i(m),surf_usm_h%j(m),nzb+1) = & 1390 local_pf(surf_usm_h%i(m),surf_usm_h%j(m),nzb+1) & 1391 + surf_usm_h%cssws(lsp,m) 1398 1392 ENDDO 1399 1393 grid = 'zu' … … 1405 1399 1406 1400 DO lsp=1,nspec 1407 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) .AND.&1401 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) .AND. & 1408 1402 ( (variable(char_len-2:) == '_xy') .OR. & 1409 1403 (variable(char_len-2:) == '_xz') .OR. & 1410 (variable(char_len-2:) == '_yz') ) ) THEN 1404 (variable(char_len-2:) == '_yz') ) ) THEN 1411 1405 ! 1412 1406 !-- todo: remove or replace by "CALL message" mechanism (kanani) 1413 1407 ! IF(myid == 0) WRITE(6,*) 'Output of species ' // TRIM( variable ) // & 1414 ! TRIM( chem_species(lsp)%name ) 1408 ! TRIM( chem_species(lsp)%name ) 1415 1409 IF (av == 0) THEN 1416 1410 DO i = nxl, nxr … … 1437 1431 ENDDO 1438 1432 ENDIF 1439 grid = 'zu' 1433 grid = 'zu' 1440 1434 found = .TRUE. 1441 1435 ENDIF … … 1445 1439 RETURN 1446 1440 1447 END SUBROUTINE chem_data_output_2d 1448 1449 1450 !------------------------------------------------------------------------------ !1441 END SUBROUTINE chem_data_output_2d 1442 1443 1444 !--------------------------------------------------------------------------------------------------! 1451 1445 ! Description: 1452 1446 ! ------------ 1453 1447 !> Subroutine defining 3D output variables for chemical species 1454 !------------------------------------------------------------------------------ !1448 !--------------------------------------------------------------------------------------------------! 1455 1449 SUBROUTINE chem_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do ) 1456 1450 … … 1459 1453 1460 1454 CHARACTER (LEN=*) :: variable !< 1461 INTEGER(iwp) :: av !< 1462 INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0) 1463 INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d) 1455 1456 INTEGER(iwp) :: av !< 1457 INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0) 1458 INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d) 1464 1459 1465 1460 LOGICAL :: found !< 1466 1461 1467 1462 REAL(wp) :: fill_value !< 1468 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf 1469 ! 1470 !-- local variables 1463 1464 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf 1465 ! 1466 !-- Local variables 1471 1467 CHARACTER(LEN=16) :: spec_name 1468 1472 1469 INTEGER(iwp) :: i 1473 1470 INTEGER(iwp) :: j … … 1489 1486 DO lsp = 1, nvar !!! cssws - nvar species, chem_species - nspec species !!! 1490 1487 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name) ) THEN 1491 1488 1492 1489 local_pf = 0.0_wp 1493 1490 ! 1494 1491 !-- no average for now 1495 1492 DO m = 1, surf_usm_h%ns 1496 local_pf(surf_usm_h%i(m),surf_usm_h%j(m),surf_usm_h%k(m)) = & 1497 local_pf(surf_usm_h%i(m),surf_usm_h%j(m),surf_usm_h%k(m)) + surf_usm_h%cssws(lsp,m) 1493 local_pf(surf_usm_h%i(m),surf_usm_h%j(m),surf_usm_h%k(m)) = & 1494 local_pf(surf_usm_h%i(m),surf_usm_h%j(m),surf_usm_h%k(m)) & 1495 + surf_usm_h%cssws(lsp,m) 1498 1496 ENDDO 1499 1497 DO m = 1, surf_lsm_h%ns 1500 local_pf(surf_lsm_h%i(m),surf_lsm_h%j(m),surf_lsm_h%k(m)) = & 1501 local_pf(surf_lsm_h%i(m),surf_lsm_h%j(m),surf_lsm_h%k(m)) + surf_lsm_h%cssws(lsp,m) 1498 local_pf(surf_lsm_h%i(m),surf_lsm_h%j(m),surf_lsm_h%k(m)) = & 1499 local_pf(surf_lsm_h%i(m),surf_lsm_h%j(m),surf_lsm_h%k(m)) & 1500 + surf_lsm_h%cssws(lsp,m) 1502 1501 ENDDO 1503 1502 DO l = 0, 3 1504 1503 DO m = 1, surf_usm_v(l)%ns 1505 local_pf(surf_usm_v(l)%i(m),surf_usm_v(l)%j(m),surf_usm_v(l)%k(m)) = & 1506 local_pf(surf_usm_v(l)%i(m),surf_usm_v(l)%j(m),surf_usm_v(l)%k(m)) + surf_usm_v(l)%cssws(lsp,m) 1504 local_pf(surf_usm_v(l)%i(m),surf_usm_v(l)%j(m),surf_usm_v(l)%k(m)) = & 1505 local_pf(surf_usm_v(l)%i(m),surf_usm_v(l)%j(m),surf_usm_v(l)%k(m)) & 1506 + surf_usm_v(l)%cssws(lsp,m) 1507 1507 ENDDO 1508 1508 DO m = 1, surf_lsm_v(l)%ns 1509 local_pf(surf_lsm_v(l)%i(m),surf_lsm_v(l)%j(m),surf_lsm_v(l)%k(m)) = & 1510 local_pf(surf_lsm_v(l)%i(m),surf_lsm_v(l)%j(m),surf_lsm_v(l)%k(m)) + surf_lsm_v(l)%cssws(lsp,m) 1509 local_pf(surf_lsm_v(l)%i(m),surf_lsm_v(l)%j(m),surf_lsm_v(l)%k(m)) = & 1510 local_pf(surf_lsm_v(l)%i(m),surf_lsm_v(l)%j(m),surf_lsm_v(l)%k(m)) & 1511 + surf_lsm_v(l)%cssws(lsp,m) 1511 1512 ENDDO 1512 1513 ENDDO … … 1516 1517 ELSE 1517 1518 DO lsp = 1, nspec 1518 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name) ) THEN1519 IF ( TRIM( spec_name ) == TRIM( chem_species(lsp)%name) ) THEN 1519 1520 ! 1520 1521 !-- todo: remove or replace by "CALL message" mechanism (kanani) 1521 1522 ! IF(myid == 0 .AND. chem_debug0 ) WRITE(6,*) 'Output of species ' // TRIM( variable ) // & 1522 ! TRIM( chem_species(lsp)%name ) 1523 ! TRIM( chem_species(lsp)%name ) 1523 1524 IF (av == 0) THEN 1524 1525 DO i = nxl, nxr 1525 1526 DO j = nys, nyn 1526 1527 DO k = nzb_do, nzt_do 1527 local_pf(i,j,k) = MERGE( &1528 chem_species(lsp)%conc(k,j,i), &1529 REAL( fill_value, KIND = wp ), &1528 local_pf(i,j,k) = MERGE( & 1529 chem_species(lsp)%conc(k,j,i), & 1530 REAL( fill_value, KIND = wp ), & 1530 1531 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 1531 1532 ENDDO … … 1538 1539 DO j = nys, nyn 1539 1540 DO k = nzb_do, nzt_do 1540 local_pf(i,j,k) = MERGE( &1541 chem_species(lsp)%conc_av(k,j,i), &1542 REAL( fill_value, KIND = wp ), &1541 local_pf(i,j,k) = MERGE( & 1542 chem_species(lsp)%conc_av(k,j,i), & 1543 REAL( fill_value, KIND = wp ), & 1543 1544 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 1544 1545 ENDDO … … 1556 1557 1557 1558 1558 !------------------------------------------------------------------------------ !1559 !--------------------------------------------------------------------------------------------------! 1559 1560 ! Description: 1560 1561 ! ------------ 1561 1562 !> Subroutine defining mask output variables for chemical species 1562 !------------------------------------------------------------------------------ !1563 !--------------------------------------------------------------------------------------------------! 1563 1564 SUBROUTINE chem_data_output_mask( av, variable, found, local_pf, mid ) 1564 1565 … … 1569 1570 CHARACTER(LEN=*) :: variable !< 1570 1571 1571 INTEGER(iwp) :: av !< flag to control data output of instantaneous or time-averaged data 1572 INTEGER(iwp) :: av !< flag to control data output of instantaneous or 1573 !< time-averaged data 1574 INTEGER(iwp) :: i !< grid index along x-direction 1575 INTEGER(iwp) :: im !< loop index for masked variables 1576 INTEGER(iwp) :: j !< grid index along y-direction 1577 INTEGER(iwp) :: jm !< loop index for masked variables 1578 INTEGER(iwp) :: k !< grid index along z-direction 1579 INTEGER(iwp) :: kk !< masked output index along z-direction 1580 INTEGER(iwp) :: ktt !< k index of highest terrain surface 1572 1581 INTEGER(iwp) :: lsp 1573 INTEGER(iwp) :: i !< grid index along x-direction1574 INTEGER(iwp) :: j !< grid index along y-direction1575 INTEGER(iwp) :: k !< grid index along z-direction1576 INTEGER(iwp) :: im !< loop index for masked variables1577 INTEGER(iwp) :: jm !< loop index for masked variables1578 INTEGER(iwp) :: kk !< masked output index along z-direction1579 1582 INTEGER(iwp) :: mid !< masked output running index 1580 INTEGER(iwp) :: ktt !< k index of highest terrain surface 1581 1583 1582 1584 LOGICAL :: found 1583 1584 REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: & 1585 local_pf !< 1585 1586 REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: local_pf !< 1586 1587 1587 1588 REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute 1588 1589 1589 1590 ! 1590 !-- local variables.1591 !-- Local variables. 1591 1592 1592 1593 spec_name = TRIM( variable(4:) ) … … 1594 1595 1595 1596 DO lsp=1,nspec 1596 IF (TRIM( spec_name ) == TRIM( chem_species(lsp)%name) ) THEN 1597 IF (TRIM( spec_name ) == TRIM( chem_species(lsp)%name) ) THEN 1597 1598 ! 1598 1599 !-- todo: remove or replace by "CALL message" mechanism (kanani) 1599 1600 ! IF(myid == 0 .AND. chem_debug0 ) WRITE(6,*) 'Output of species ' // TRIM( variable ) // & 1600 ! TRIM( chem_species(lsp)%name ) 1601 ! TRIM( chem_species(lsp)%name ) 1601 1602 IF (av == 0) THEN 1602 1603 IF ( .NOT. mask_surface(mid) ) THEN 1603 1604 1604 1605 DO i = 1, mask_size_l(mid,1) 1605 DO j = 1, mask_size_l(mid,2) 1606 DO k = 1, mask_size(mid,3) 1607 local_pf(i,j,k) = chem_species(lsp)%conc( & 1608 mask_k(mid,k), & 1609 mask_j(mid,j), & 1610 mask_i(mid,i) ) 1606 DO j = 1, mask_size_l(mid,2) 1607 DO k = 1, mask_size(mid,3) 1608 local_pf(i,j,k) = chem_species(lsp)%conc( mask_k(mid,k), & 1609 mask_j(mid,j), & 1610 mask_i(mid,i) ) 1611 1611 ENDDO 1612 1612 ENDDO … … 1614 1614 1615 1615 ELSE 1616 ! 1616 ! 1617 1617 !-- Terrain-following masked output 1618 1618 DO i = 1, mask_size_l(mid,1) 1619 1619 DO j = 1, mask_size_l(mid,2) 1620 ! 1620 1621 !-- Get k index of the highest terraing surface 1621 1622 im = mask_i(mid,i) 1622 1623 jm = mask_j(mid,j) 1623 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), DIM = 1 ) - 1 1624 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ), & 1625 DIM = 1 ) - 1 1624 1626 DO k = 1, mask_size_l(mid,3) 1625 1627 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 1628 ! 1626 1629 !-- Set value if not in building 1627 1630 IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN … … 1641 1644 DO j = 1, mask_size_l(mid,2) 1642 1645 DO k = 1, mask_size_l(mid,3) 1643 local_pf(i,j,k) = chem_species(lsp)%conc_av( & 1644 mask_k(mid,k), & 1645 mask_j(mid,j), & 1646 mask_i(mid,i) ) 1646 local_pf(i,j,k) = chem_species(lsp)%conc_av( mask_k(mid,k), & 1647 mask_j(mid,j), & 1648 mask_i(mid,i) ) 1647 1649 ENDDO 1648 1650 ENDDO … … 1650 1652 1651 1653 ELSE 1652 ! 1654 ! 1653 1655 !-- Terrain-following masked output 1654 1656 DO i = 1, mask_size_l(mid,1) 1655 1657 DO j = 1, mask_size_l(mid,2) 1658 ! 1656 1659 !-- Get k index of the highest terraing surface 1657 1660 im = mask_i(mid,i) 1658 1661 jm = mask_j(mid,j) 1659 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), DIM = 1 ) - 1 1662 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & 1663 DIM = 1 ) - 1 1660 1664 DO k = 1, mask_size_l(mid,3) 1661 1665 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 1666 ! 1662 1667 !-- Set value if not in building 1663 1668 IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN … … 1680 1685 RETURN 1681 1686 1682 END SUBROUTINE chem_data_output_mask 1683 1684 1685 !------------------------------------------------------------------------------ !1687 END SUBROUTINE chem_data_output_mask 1688 1689 1690 !--------------------------------------------------------------------------------------------------! 1686 1691 ! Description: 1687 1692 ! ------------ 1688 1693 !> Subroutine defining appropriate grid for netcdf variables. 1689 1694 !> It is called out from subroutine netcdf. 1690 !------------------------------------------------------------------------------ !1695 !--------------------------------------------------------------------------------------------------! 1691 1696 SUBROUTINE chem_define_netcdf_grid( var, found, grid_x, grid_y, grid_z ) 1692 1697 1693 1698 1694 1699 CHARACTER (LEN=*), INTENT(IN) :: var !< 1695 LOGICAL, INTENT(OUT) :: found !< 1700 1696 1701 CHARACTER (LEN=*), INTENT(OUT) :: grid_x !< 1697 1702 CHARACTER (LEN=*), INTENT(OUT) :: grid_y !< 1698 1703 CHARACTER (LEN=*), INTENT(OUT) :: grid_z !< 1699 1704 1705 LOGICAL, INTENT(OUT) :: found !< 1706 1700 1707 found = .TRUE. 1701 1708 1702 IF ( var(1:3) == 'kc_' .OR. var(1:3) == 'em_' ) THEN !< always the same grid for chemistry variables 1709 IF ( var(1:3) == 'kc_' .OR. var(1:3) == 'em_' ) THEN !< always the same grid for 1710 !< chemistry variables 1703 1711 grid_x = 'x' 1704 1712 grid_y = 'y' 1705 grid_z = 'zu' 1713 grid_z = 'zu' 1706 1714 ELSE 1707 1715 found = .FALSE. … … 1715 1723 1716 1724 1717 !------------------------------------------------------------------------------ !1725 !--------------------------------------------------------------------------------------------------! 1718 1726 ! Description: 1719 1727 ! ------------ 1720 1728 !> Subroutine defining header output for chemistry model 1721 !------------------------------------------------------------------------------ !1729 !--------------------------------------------------------------------------------------------------! 1722 1730 SUBROUTINE chem_header( io ) 1723 1731 1724 1725 INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file1726 INTEGER(iwp) :: lsp !< running index for chem spcs1727 INTEGER(iwp) :: cs_fixed1728 1732 CHARACTER (LEN=80) :: docsflux_chr 1729 1733 CHARACTER (LEN=80) :: docsinit_chr 1730 ! 1731 ! Get name of chemical mechanism from chem_gasphase_mod 1734 1735 INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file 1736 1737 INTEGER(iwp) :: cs_fixed 1738 INTEGER(iwp) :: lsp !< running index for chem spcs 1739 1740 ! 1741 !-- Get name of chemical mechanism from chem_gasphase_mod 1732 1742 CALL get_mechanism_name 1733 1743 ! … … 1736 1746 ! 1737 1747 !-- Gasphase reaction status 1738 IF ( chem_gasphase_on ) THEN 1748 IF ( chem_gasphase_on ) THEN 1739 1749 WRITE( io, 2 ) 1740 1750 ELSE … … 1746 1756 ! 1747 1757 !-- Emission mode info 1748 !-- At the moment the evaluation is done with both emiss_lod and mode_emis 1749 !-- but once salsa has been migrated to emiss_lod the .OR. mode_emis 1750 !-- conditions can be removed (ecc 20190513) 1751 IF ( (emiss_lod == 1) .OR. (mode_emis == 'DEFAULT') ) THEN 1758 !-- At the moment the evaluation is done with both emiss_lod and mode_emis but once salsa has been 1759 !-- migrated to emiss_lod the .OR. mode_emis conditions can be removed (ecc 20190513) 1760 IF ( ( emiss_lod == 1 ) .OR. ( mode_emis == 'DEFAULT' ) ) THEN 1752 1761 WRITE ( io, 5 ) 1753 ELSEIF ( ( emiss_lod == 0) .OR. (mode_emis == 'PARAMETERIZED') ) THEN1762 ELSEIF ( ( emiss_lod == 0 ) .OR. ( mode_emis == 'PARAMETERIZED' ) ) THEN 1754 1763 WRITE ( io, 6 ) 1755 ELSEIF ( ( emiss_lod == 2) .OR. (mode_emis == 'PRE-PROCESSED') ) THEN1764 ELSEIF ( ( emiss_lod == 2 ) .OR. ( mode_emis == 'PRE-PROCESSED' ) ) THEN 1756 1765 WRITE ( io, 7 ) 1757 1766 ENDIF … … 1759 1768 !-- Photolysis scheme info 1760 1769 IF ( photolysis_scheme == "simple" ) THEN 1761 WRITE( io, 8 ) 1770 WRITE( io, 8 ) 1762 1771 ELSEIF (photolysis_scheme == "constant" ) THEN 1763 1772 WRITE( io, 9 ) … … 1766 1775 !-- Emission flux info 1767 1776 lsp = 1 1768 docsflux_chr ='Chemical species for surface emission flux: ' 1777 docsflux_chr ='Chemical species for surface emission flux: ' 1769 1778 DO WHILE ( surface_csflux_name(lsp) /= 'novalue' ) 1770 docsflux_chr = TRIM( docsflux_chr ) // ' ' // TRIM( surface_csflux_name(lsp) ) // ',' 1779 docsflux_chr = TRIM( docsflux_chr ) // ' ' // TRIM( surface_csflux_name(lsp) ) // ',' 1771 1780 IF ( LEN_TRIM( docsflux_chr ) >= 75 ) THEN 1772 1781 WRITE ( io, 10 ) docsflux_chr … … 1780 1789 ENDIF 1781 1790 ! 1782 !-- initializatoin of Surface and profile chemical species1791 !-- Initialization of Surface and profile chemical species 1783 1792 lsp = 1 1784 docsinit_chr ='Chemical species for initial surface and profile emissions: ' 1793 docsinit_chr ='Chemical species for initial surface and profile emissions: ' 1785 1794 DO WHILE ( cs_name(lsp) /= 'novalue' ) 1786 docsinit_chr = TRIM( docsinit_chr ) // ' ' // TRIM( cs_name(lsp) ) // ',' 1795 docsinit_chr = TRIM( docsinit_chr ) // ' ' // TRIM( cs_name(lsp) ) // ',' 1787 1796 IF ( LEN_TRIM( docsinit_chr ) >= 75 ) THEN 1788 WRITE ( io, 11 ) docsinit_chr1789 docsinit_chr = ' '1797 WRITE ( io, 11 ) docsinit_chr 1798 docsinit_chr = ' ' 1790 1799 ENDIF 1791 1800 lsp = lsp + 1 … … 1803 1812 1804 1813 ! 1805 !-- number of variable and fix chemical species and number of reactions1814 !-- Number of variable and fix chemical species and number of reactions 1806 1815 cs_fixed = nspec - nvar 1807 WRITE ( io, * ) ' --> Chemical Mechanism : ', cs_mech 1816 WRITE ( io, * ) ' --> Chemical Mechanism : ', cs_mech 1808 1817 WRITE ( io, * ) ' --> Chemical species, variable: ', nvar 1809 1818 WRITE ( io, * ) ' --> Chemical species, fixed : ', cs_fixed … … 1811 1820 1812 1821 1813 1 FORMAT (//' Chemistry model information:'/ & 1814 ' ----------------------------'/) 1822 1 FORMAT (//' Chemistry model information:'/' ----------------------------'/) 1815 1823 2 FORMAT (' --> Chemical reactions are turned on') 1816 1824 3 FORMAT (' --> Chemical reactions are turned off') … … 1821 1829 8 FORMAT (' --> Photolysis scheme used = simple ') 1822 1830 9 FORMAT (' --> Photolysis scheme used = constant ') 1823 10 FORMAT (/' ',A) 1824 11 FORMAT (/' ',A) 1831 10 FORMAT (/' ',A) 1832 11 FORMAT (/' ',A) 1825 1833 12 FORMAT (/' Nesting for chemistry variables: ', L1 ) 1826 1834 13 FORMAT (/' Offline nesting for chemistry variables: ', L1 ) … … 1833 1841 1834 1842 1835 !------------------------------------------------------------------------------ !1843 !--------------------------------------------------------------------------------------------------! 1836 1844 ! Description: 1837 1845 ! ------------ 1838 1846 !> Subroutine initializating chemistry_model_mod specific arrays 1839 !------------------------------------------------------------------------------ !1847 !--------------------------------------------------------------------------------------------------! 1840 1848 SUBROUTINE chem_init_arrays 1841 1849 ! … … 1845 1853 1846 1854 1847 !------------------------------------------------------------------------------ !1855 !--------------------------------------------------------------------------------------------------! 1848 1856 ! Description: 1849 1857 ! ------------ 1850 1858 !> Subroutine initializating chemistry_model_mod 1851 !------------------------------------------------------------------------------ !1859 !--------------------------------------------------------------------------------------------------! 1852 1860 SUBROUTINE chem_init 1853 1861 … … 1856 1864 !-- introduced additional interfaces for on-demand emission update 1857 1865 1858 ! USE chem_emissions_mod, &1866 ! USE chem_emissions_mod, & 1859 1867 ! ONLY: chem_emissions_init 1860 1861 USE chem_emissions_mod, &1862 ONLY: chem_emissions_ init, chem_emissions_header_init1863 1864 USE netcdf_data_input_mod, &1868 1869 USE chem_emissions_mod, & 1870 ONLY: chem_emissions_header_init, chem_emissions_init 1871 1872 USE netcdf_data_input_mod, & 1865 1873 ONLY: init_3d 1866 1874 … … 1874 1882 ! 1875 1883 !-- Next statement is to avoid compiler warning about unused variables 1876 IF ( ( ilu_arable + ilu_coniferous_forest + ilu_deciduous_forest + ilu_mediterrean_scrub + &1877 ilu_permanent_crops + ilu_savanna + ilu_semi_natural_veg + ilu_tropical_forest + &1884 IF ( ( ilu_arable + ilu_coniferous_forest + ilu_deciduous_forest + ilu_mediterrean_scrub + & 1885 ilu_permanent_crops + ilu_savanna + ilu_semi_natural_veg + ilu_tropical_forest + & 1878 1886 ilu_urban ) == 0 ) CONTINUE 1879 1887 1880 1888 ! 1881 1889 !-- 20200203 (ECC) 1882 !-- calls specific emisisons initialization subroutines 1883 !-- for legacy mode and on-demand mode 1890 !-- Calls specific emisisons initialization subroutines for legacy mode and on-demand mode 1884 1891 1885 1892 ! IF ( emissions_anthropogenic ) CALL chem_emissions_init … … 1897 1904 1898 1905 ! 1899 !-- Chemistry variables will be initialized if availabe from dynamic 1900 !-- input file. Note, it is possible to initialize only part of the chemistry 1901 !-- variables from dynamic input. 1906 !-- Chemistry variables will be initialized if availabe from dynamic input file. Note, it is 1907 !-- possible to initialize only part of the chemistry variables from dynamic input. 1902 1908 IF ( INDEX( initializing_actions, 'inifor' ) /= 0 ) THEN 1903 1909 DO n = 1, nspec … … 1917 1923 1918 1924 1919 !------------------------------------------------------------------------------ !1925 !--------------------------------------------------------------------------------------------------! 1920 1926 ! Description: 1921 1927 ! ------------ 1922 1928 !> Subroutine initializating chemistry_model_mod 1923 1929 !> internal workaround for chem_species dependency in chem_check_parameters 1924 !------------------------------------------------------------------------------ !1930 !--------------------------------------------------------------------------------------------------! 1925 1931 SUBROUTINE chem_init_internal 1926 1932 1927 1933 USE pegrid 1928 1934 1929 USE netcdf_data_input_mod, &1930 ONLY: chem_emis, chem_emis_att, input_pids_dynamic, init_3d, &1935 USE netcdf_data_input_mod, & 1936 ONLY: chem_emis, chem_emis_att, input_pids_dynamic, init_3d, & 1931 1937 netcdf_data_input_chemistry_data 1932 1938 … … 1935 1941 INTEGER(iwp) :: i !< running index for for horiz numerical grid points 1936 1942 INTEGER(iwp) :: j !< running index for for horiz numerical grid points 1943 INTEGER(iwp) :: lpr_lev !< running index for chem spcs profile level 1937 1944 INTEGER(iwp) :: lsp !< running index for chem spcs 1938 INTEGER(iwp) :: lpr_lev !< running index for chem spcs profile level1939 1945 1940 1946 REAL(wp) :: flag !< flag for masking topography/building grid points … … 1959 1965 ALLOCATE( spec_conc_2 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) ) 1960 1966 ALLOCATE( spec_conc_3 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) ) 1961 ALLOCATE( phot_frequen(nphot) ) 1967 ALLOCATE( phot_frequen(nphot) ) 1962 1968 ALLOCATE( freq_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nphot) ) 1963 1969 ALLOCATE( bc_cs_t_val(nspec) ) … … 1976 1982 chem_species(lsp)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_3 (:,:,:,lsp) 1977 1983 1978 ALLOCATE (chem_species(lsp)%cssws_av(nysg:nyng,nxlg:nxrg)) 1984 ALLOCATE (chem_species(lsp)%cssws_av(nysg:nyng,nxlg:nxrg)) 1979 1985 chem_species(lsp)%cssws_av = 0.0_wp 1980 1986 ! 1981 1987 !-- The following block can be useful when emission module is not applied. & 1982 !-- if emission module is applied the following block will be overwritten. 1983 ALLOCATE (chem_species(lsp)%flux_s_cs(nzb+1:nzt,0:threads_per_task-1)) 1984 ALLOCATE (chem_species(lsp)%diss_s_cs(nzb+1:nzt,0:threads_per_task-1)) 1985 ALLOCATE (chem_species(lsp)%flux_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1)) 1986 ALLOCATE (chem_species(lsp)%diss_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1)) 1987 chem_species(lsp)%flux_s_cs = 0.0_wp 1988 chem_species(lsp)%flux_l_cs = 0.0_wp 1989 chem_species(lsp)%diss_s_cs = 0.0_wp 1990 chem_species(lsp)%diss_l_cs = 0.0_wp 1991 ! 1992 !-- Allocate memory for initial concentration profiles 1993 !-- (concentration values come from namelist) 1994 !-- (@todo (FK): Because of this, chem_init is called in palm before 1995 !-- check_parameters, since conc_pr_init is used there. 1996 !-- We have to find another solution since chem_init should 1997 !-- eventually be called from init_3d_model!!) 1988 !-- If emission module is applied the following block will be overwritten. 1989 ALLOCATE (chem_species(lsp)%flux_s_cs(nzb+1:nzt,0:threads_per_task-1)) 1990 ALLOCATE (chem_species(lsp)%diss_s_cs(nzb+1:nzt,0:threads_per_task-1)) 1991 ALLOCATE (chem_species(lsp)%flux_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1)) 1992 ALLOCATE (chem_species(lsp)%diss_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1)) 1993 chem_species(lsp)%flux_s_cs = 0.0_wp 1994 chem_species(lsp)%flux_l_cs = 0.0_wp 1995 chem_species(lsp)%diss_s_cs = 0.0_wp 1996 chem_species(lsp)%diss_l_cs = 0.0_wp 1997 ! 1998 !-- Allocate memory for initial concentration profiles (concentration values come from namelist) 1999 !-- (@todo (FK): Because of this, chem_init is called in palm before check_parameters, since 2000 !-- conc_pr_init is used there. 2001 !-- We have to find another solution since chem_init should eventually be called from 2002 !-- init_3d_model!!) 1998 2003 ALLOCATE ( chem_species(lsp)%conc_pr_init(0:nz+1) ) 1999 2004 chem_species(lsp)%conc_pr_init(:) = 0.0_wp … … 2002 2007 2003 2008 ! 2004 !-- For some passive scalars decycling may be enabled. This case, the lateral 2005 !-- boundary conditions are non-cyclic for these scalars (chemical species 2006 !-- and aerosols), while the other scalars may have 2007 !-- cyclic boundary conditions. However, large gradients near the boundaries 2008 !-- may produce stationary numerical oscillations near the lateral boundaries 2009 !-- when a higher-order scheme is applied near these boundaries. 2010 !-- To get rid-off this, set-up additional flags that control the order of the 2011 !-- scalar advection scheme near the lateral boundaries for passive scalars 2012 !-- with decycling. 2009 !-- For some passive scalars decycling may be enabled. This case, the lateral boundary conditions 2010 !-- are non-cyclic for these scalars (chemical species and aerosols), while the other scalars may 2011 !-- have cyclic boundary conditions. However, large gradients near the boundaries may produce 2012 !-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is 2013 !-- applied near these boundaries. 2014 !-- To get rid-off this, set-up additional flags that control the order of the scalar advection 2015 !-- scheme near the lateral boundaries for passive scalars with decycling. 2013 2016 IF ( scalar_advec == 'ws-scheme' ) THEN 2014 2017 ALLOCATE( cs_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 2015 2018 ! 2016 !-- In case of decyling, set Neumann boundary conditions for wall_flags_total_0 2017 !-- bit 31 instead of cyclic boundary conditions. 2018 !-- Bit 31 is used to identify extended degradation zones (please see 2019 !-- following comment). 2020 !-- Note, since several also other modules like Salsa or other future 2021 !-- one may access this bit but may have other boundary conditions, the 2022 !-- original value of wall_flags_total_0 bit 31 must not be modified. Hence, 2023 !-- store the boundary conditions directly on cs_advc_flags_s. 2024 !-- cs_advc_flags_s will be later overwritten in ws_init_flags_scalar and 2025 !-- bit 31 won't be used to control the numerical order. 2026 !-- Initialize with flag 31 only. 2019 !-- In case of decyling, set Neumann boundary conditions for wall_flags_total_0 bit 31 instead of 2020 !-- cyclic boundary conditions. 2021 !-- Bit 31 is used to identify extended degradation zones (please see following comment). 2022 !-- Note, since several also other modules like Salsa or other future one may access this bit but 2023 !-- may have other boundary conditions, the original value of wall_flags_total_0 bit 31 must not 2024 !-- be modified. Hence, store the boundary conditions directly on cs_advc_flags_s. 2025 !-- cs_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used to 2026 !-- control the numerical order. 2027 !-- Initialize with flag 31 only. 2027 2028 cs_advc_flags_s = 0 2028 2029 cs_advc_flags_s = MERGE( IBSET( cs_advc_flags_s, 31 ), 0, BTEST( wall_flags_total_0, 31 ) ) … … 2031 2032 IF ( nys == 0 ) THEN 2032 2033 DO i = 1, nbgp 2033 cs_advc_flags_s(:,nys-i,:) = MERGE( &2034 IBSET( cs_advc_flags_s(:,nys,:), 31 ),&2035 IBCLR( cs_advc_flags_s(:,nys,:), 31 ),&2036 BTEST( cs_advc_flags_s(:,nys,:), 31 )&2034 cs_advc_flags_s(:,nys-i,:) = MERGE( & 2035 IBSET( cs_advc_flags_s(:,nys,:), 31 ), & 2036 IBCLR( cs_advc_flags_s(:,nys,:), 31 ), & 2037 BTEST( cs_advc_flags_s(:,nys,:), 31 ) & 2037 2038 ) 2038 2039 ENDDO … … 2040 2041 IF ( nyn == ny ) THEN 2041 2042 DO i = 1, nbgp 2042 cs_advc_flags_s(:,nyn+i,:) = MERGE( &2043 IBSET( cs_advc_flags_s(:,nyn,:), 31 ),&2044 IBCLR( cs_advc_flags_s(:,nyn,:), 31 ),&2045 BTEST( cs_advc_flags_s(:,nyn,:), 31 )&2043 cs_advc_flags_s(:,nyn+i,:) = MERGE( & 2044 IBSET( cs_advc_flags_s(:,nyn,:), 31 ), & 2045 IBCLR( cs_advc_flags_s(:,nyn,:), 31 ), & 2046 BTEST( cs_advc_flags_s(:,nyn,:), 31 ) & 2046 2047 ) 2047 2048 ENDDO … … 2051 2052 IF ( nxl == 0 ) THEN 2052 2053 DO i = 1, nbgp 2053 cs_advc_flags_s(:,:,nxl-i) = MERGE( &2054 IBSET( cs_advc_flags_s(:,:,nxl), 31 ),&2055 IBCLR( cs_advc_flags_s(:,:,nxl), 31 ),&2056 BTEST( cs_advc_flags_s(:,:,nxl), 31 )&2054 cs_advc_flags_s(:,:,nxl-i) = MERGE( & 2055 IBSET( cs_advc_flags_s(:,:,nxl), 31 ), & 2056 IBCLR( cs_advc_flags_s(:,:,nxl), 31 ), & 2057 BTEST( cs_advc_flags_s(:,:,nxl), 31 ) & 2057 2058 ) 2058 2059 ENDDO … … 2060 2061 IF ( nxr == nx ) THEN 2061 2062 DO i = 1, nbgp 2062 cs_advc_flags_s(:,:,nxr+i) = MERGE( &2063 IBSET( cs_advc_flags_s(:,:,nxr), 31 ), &2064 IBCLR( cs_advc_flags_s(:,:,nxr), 31 ), &2065 BTEST( cs_advc_flags_s(:,:,nxr), 31 ) &2063 cs_advc_flags_s(:,:,nxr+i) = MERGE( & 2064 IBSET( cs_advc_flags_s(:,:,nxr), 31 ), & 2065 IBCLR( cs_advc_flags_s(:,:,nxr), 31 ), & 2066 BTEST( cs_advc_flags_s(:,:,nxr), 31 ) & 2066 2067 ) 2067 2068 ENDDO … … 2069 2070 ENDIF 2070 2071 ! 2071 !-- To initialize advection flags appropriately, pass the boundary flags. 2072 !-- The last argument indicates that a passive scalar is treated, where 2073 !-- t he horizontal advection terms are degraded already 2 grid points before2074 !-- the lateral boundary to avoid stationary oscillations at large-gradients.2075 !-- Also, extended degradation zones are applied, where horizontal advection of 2076 !-- passive scalars is discretized by first-order scheme at all grid points2077 !-- that in the vicinity of buildings (<= 3 grid points). Even though no2078 !-- building is within the numerical stencil, first-order scheme is used.2072 !-- To initialize advection flags appropriately, pass the boundary flags. 2073 !-- The last argument indicates that a passive scalar is treated, where the horizontal advection 2074 !-- terms are degraded already 2 grid points before the lateral boundary to avoid stationary 2075 !-- oscillations at large-gradients. 2076 !-- Also, extended degradation zones are applied, where horizontal advection of passive scalars 2077 !-- is discretized by first-order scheme at all grid points that in the vicinity of buildings 2078 !-- (<= 3 grid points). Even though no building is within the numerical stencil, first-order 2079 !-- scheme is used. 2079 2080 !-- At fourth and fifth grid point the order of the horizontal advection scheme 2080 2081 !-- is successively upgraded. 2081 !-- These extended degradation zones are used to avoid stationary numerical 2082 !-- oscillations, which are responsible for high concentration maxima that may2083 !-- appear under shear-free stable conditions.2082 !-- These extended degradation zones are used to avoid stationary numerical oscillations, which 2083 !-- are responsible for high concentration maxima that may appear under shear-free stable 2084 !-- conditions. 2084 2085 CALL ws_init_flags_scalar( bc_dirichlet_cs_l .OR. bc_radiation_cs_l, & 2085 2086 bc_dirichlet_cs_n .OR. bc_radiation_cs_n, & … … 2089 2090 ENDIF 2090 2091 ! 2091 !-- Initial concentration of profiles is prescribed by parameters cs_profile 2092 !-- and cs_heights in the namelist &chemistry_parameters 2093 2092 !-- Initial concentration of profiles is prescribed by parameters cs_profile and cs_heights in the 2093 !-- namelist &chemistry_parameters. 2094 2094 CALL chem_init_profiles 2095 ! 2096 !-- In case there is dynamic input file, create a list of names for chemistry 2097 !-- initial input files. Also, initialize array that indicates whether the 2098 !-- respective variable is on file or not. 2099 IF ( input_pids_dynamic ) THEN 2095 ! 2096 !-- In case there is dynamic input file, create a list of names for chemistry initial input files. 2097 !-- Also, initialize array that indicates whether the respective variable is on file or not. 2098 IF ( input_pids_dynamic ) THEN 2100 2099 ALLOCATE( init_3d%var_names_chem(1:nspec) ) 2101 2100 ALLOCATE( init_3d%from_file_chem(1:nspec) ) 2102 2101 init_3d%from_file_chem(:) = .FALSE. 2103 2102 2104 2103 DO lsp = 1, nspec 2105 2104 init_3d%var_names_chem(lsp) = init_3d%init_char // TRIM( chem_species(lsp)%name ) … … 2108 2107 ! 2109 2108 !-- Initialize model variables 2110 IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. &2109 IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. & 2111 2110 TRIM( initializing_actions ) /= 'cyclic_fill' ) THEN 2112 2111 ! … … 2126 2125 ENDDO 2127 2126 ENDDO 2128 ENDDO 2127 ENDDO 2129 2128 ENDDO 2130 2129 2131 ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 ) & 2132 THEN 2133 2134 DO lsp = 1, nspec 2130 ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles') /= 0 ) THEN 2131 2132 DO lsp = 1, nspec 2135 2133 DO i = nxlg, nxrg 2136 2134 DO j = nysg, nyng … … 2147 2145 ! 2148 2146 !-- If required, change the surface chem spcs at the start of the 3D run 2149 IF ( cs_surface_initial_change(1) /= 0.0_wp ) THEN 2150 DO lsp = 1, nspec 2147 IF ( cs_surface_initial_change(1) /= 0.0_wp ) THEN 2148 DO lsp = 1, nspec 2151 2149 DO i = nxlg, nxrg 2152 2150 DO j = nysg, nyng 2153 2151 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb,j,i), 0 ) ) 2154 chem_species(lsp)%conc(nzb,j,i) = chem_species(lsp)%conc(nzb,j,i) + &2152 chem_species(lsp)%conc(nzb,j,i) = chem_species(lsp)%conc(nzb,j,i) + & 2155 2153 cs_surface_initial_change(lsp) * flag 2156 2154 ENDDO 2157 2155 ENDDO 2158 2156 ENDDO 2159 ENDIF 2157 ENDIF 2160 2158 2161 2159 ENDIF 2162 2160 ! 2163 !-- Initial eold and new time levels. Note, this has to be done also in restart runs2161 !-- Initial old and new time levels. Note, this has to be done also in restart runs 2164 2162 DO lsp = 1, nvar 2165 chem_species(lsp)%tconc_m = 0.0_wp 2166 chem_species(lsp)%conc_p = chem_species(lsp)%conc 2163 chem_species(lsp)%tconc_m = 0.0_wp 2164 chem_species(lsp)%conc_p = chem_species(lsp)%conc 2167 2165 ENDDO 2168 2166 … … 2173 2171 !-- IF( myid == 0 ) THEN 2174 2172 !-- WRITE(6,'(a,i4,3x,a)') 'Photolysis: ',lsp,TRIM( phot_names(lsp) ) 2175 !-- ENDIF 2173 !-- ENDIF 2176 2174 phot_frequen(lsp)%freq(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => freq_1(:,:,:,lsp) 2177 2175 ENDDO … … 2184 2182 2185 2183 2186 !------------------------------------------------------------------------------ !2184 !--------------------------------------------------------------------------------------------------! 2187 2185 ! Description: 2188 2186 ! ------------ 2189 !> Subroutine defining initial vertical profiles of chemical species (given by 2190 !> namelist parameters chem_profiles and chem_heights) --> which should work2191 !> analogue to parameters u_profile,v_profile and uv_heights)2192 !------------------------------------------------------------------------------ !2193 SUBROUTINE chem_init_profiles 2187 !> Subroutine defining initial vertical profiles of chemical species (given by namelist parameters 2188 !> chem_profiles and chem_heights) --> which should work analogically to parameters u_profile, 2189 !> v_profile and uv_heights) 2190 !--------------------------------------------------------------------------------------------------! 2191 SUBROUTINE chem_init_profiles 2194 2192 2195 2193 USE chem_modules … … 2197 2195 ! 2198 2196 !-- Local variables 2197 INTEGER :: lpr_lev !< running index for profile level for each chem spcs. 2199 2198 INTEGER :: lsp !< running index for number of species in derived data type species_def 2200 INTEGER :: lsp_usr !< running index for number of species (user defined) in cs_names, cs_profiles etc2201 INTEGER :: lpr_lev !< running index for profile level for each chem spcs.2199 INTEGER :: lsp_usr !< running index for number of species (user defined) in cs_names, 2200 !< cs_profiles etc 2202 2201 INTEGER :: npr_lev !< the next available profile lev 2203 2202 ! … … 2207 2206 !-- "cs_heights" are prescribed, their values will!override the constant profile given by 2208 2207 !-- "cs_surface". 2209 ! IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN 2208 ! IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN 2210 2209 lsp_usr = 1 2211 2210 DO WHILE ( TRIM( cs_name( lsp_usr ) ) /= 'novalue' ) !'novalue' is the default 2212 2211 DO lsp = 1, nspec ! 2213 2212 ! 2214 !-- create initial profile (conc_pr_init) for each chemical species2215 IF ( TRIM( chem_species(lsp)%name ) == TRIM( cs_name(lsp_usr) ) ) THEN !2213 !-- Create initial profile (conc_pr_init) for each chemical species 2214 IF ( TRIM( chem_species(lsp)%name ) == TRIM( cs_name(lsp_usr) ) ) THEN 2216 2215 IF ( cs_profile(lsp_usr,1) == 9999999.9_wp ) THEN 2217 2216 ! 2218 !-- set a vertically constant profile based on the surface conc (cs_surface(lsp_usr)) of each species 2217 !-- Set a vertically constant profile based on the surface conc (cs_surface(lsp_usr)) of 2218 !-- each species 2219 2219 DO lpr_lev = 0, nzt+1 2220 2220 chem_species(lsp)%conc_pr_init(lpr_lev) = cs_surface(lsp_usr) … … 2236 2236 IF ( npr_lev == 100 ) THEN 2237 2237 message_string = 'number of chem spcs exceeding the limit' 2238 CALL message( 'chem_check_parameters', 'CM0435', 1, 2, 0, 6, 0 ) 2238 CALL message( 'chem_check_parameters', 'CM0435', 1, 2, 0, 6, 0 ) 2239 2239 EXIT 2240 2240 ENDIF … … 2242 2242 ENDIF 2243 2243 IF ( npr_lev < 100 .AND. cs_heights(lsp_usr,npr_lev+1) /= 9999999.9_wp ) THEN 2244 chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp_usr, npr_lev) + 2245 ( zu(lpr_lev) - cs_heights(lsp_usr, npr_lev) ) / 2246 ( cs_heights(lsp_usr, (npr_lev + 1)) - cs_heights(lsp_usr, npr_lev ) ) * 2244 chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp_usr, npr_lev) + & 2245 ( zu(lpr_lev) - cs_heights(lsp_usr, npr_lev) ) / & 2246 ( cs_heights(lsp_usr, (npr_lev + 1)) - cs_heights(lsp_usr, npr_lev ) ) *& 2247 2247 ( cs_profile(lsp_usr, (npr_lev + 1)) - cs_profile(lsp_usr, npr_lev ) ) 2248 2248 ELSE … … 2252 2252 ENDIF 2253 2253 ! 2254 !-- If a profile is prescribed explicity using cs_profiles and cs_heights, then 2255 !-- chem_species(lsp)%conc_pr_init is populated with the specific "lsp" based 2256 !-- on the cs_profiles(lsp_usr,:) and cs_heights(lsp_usr,:).2254 !-- If a profile is prescribed explicity using cs_profiles and cs_heights, then 2255 !-- chem_species(lsp)%conc_pr_init is populated with the specific "lsp" based on the 2256 !-- cs_profiles(lsp_usr,:) and cs_heights(lsp_usr,:). 2257 2257 ENDIF 2258 2258 … … 2265 2265 END SUBROUTINE chem_init_profiles 2266 2266 2267 2268 !------------------------------------------------------------------------------ !2267 2268 !--------------------------------------------------------------------------------------------------! 2269 2269 ! Description: 2270 2270 ! ------------ 2271 2271 !> Subroutine to integrate chemical species in the given chemical mechanism 2272 !------------------------------------------------------------------------------ !2272 !--------------------------------------------------------------------------------------------------! 2273 2273 SUBROUTINE chem_integrate_ij( i, j ) 2274 2274 2275 USE statistics, &2275 USE statistics, & 2276 2276 ONLY: weight_pres 2277 2277 2278 USE control_parameters, &2278 USE control_parameters, & 2279 2279 ONLY: dt_3d, intermediate_timestep_count, time_since_reference_point 2280 2280 … … 2283 2283 INTEGER,INTENT(IN) :: j 2284 2284 ! 2285 !-- local variables 2286 INTEGER(iwp) :: lsp !< running index for chem spcs. 2287 INTEGER(iwp) :: lph !< running index for photolysis frequencies 2288 INTEGER, DIMENSION(20) :: istatus 2285 !-- Local variables 2286 INTEGER(iwp) :: lph !< running index for photolysis frequencies 2287 INTEGER(iwp) :: lsp !< running index for chem spcs. 2288 2289 INTEGER, DIMENSION(20) :: istatus 2290 2291 INTEGER,DIMENSION(nzb+1:nzt) :: nacc !< Number of accepted steps 2292 INTEGER,DIMENSION(nzb+1:nzt) :: nrej !< Number of rejected steps 2293 2294 REAL(wp) :: conv !< conversion factor 2295 REAL(kind=wp) :: dt_chem 2296 2297 REAL(wp), PARAMETER :: fr2ppm = 1.0e6_wp !< Conversion factor 2298 !< fraction to ppm 2299 ! REAL(wp), PARAMETER :: xm_air = 28.96_wp !< Mole mass of dry air 2300 ! REAL(wp), PARAMETER :: xm_h2o = 18.01528_wp !< Mole mass of water vapor 2301 REAL(wp), PARAMETER :: p_std = 101325.0_wp !< standard pressure (Pa) 2302 REAL(wp), PARAMETER :: ppm2fr = 1.0e-6_wp !< Conversion factor ppm to 2303 !< fraction 2304 REAL(wp), PARAMETER :: t_std = 273.15_wp !< standard pressure (Pa) 2305 REAL(wp), PARAMETER :: vmolcm = 22.414e3_wp !< Mole volume (22.414 l) 2306 !< in cm^3 2307 REAL(wp), PARAMETER :: xna = 6.022e23_wp !< Avogadro number 2308 !< (molecules/mol) 2309 2310 REAL(wp),DIMENSION(size(rcntrl)) :: rcntrl_local 2311 2312 REAL(kind=wp), DIMENSION(nzb+1:nzt) :: tmp_fact 2313 REAL(kind=wp), DIMENSION(nzb+1:nzt) :: tmp_fact_i !< conversion factor between 2314 !< molecules cm^{-3} and ppm 2315 REAL(kind=wp), DIMENSION(nzb+1:nzt) :: tmp_qvap 2316 REAL(kind=wp), DIMENSION(nzb+1:nzt) :: tmp_temp 2317 2289 2318 REAL(kind=wp), DIMENSION(nzb+1:nzt,nspec) :: tmp_conc 2290 REAL(kind=wp), DIMENSION(nzb+1:nzt) :: tmp_temp2291 REAL(kind=wp), DIMENSION(nzb+1:nzt) :: tmp_qvap2292 2319 REAL(kind=wp), DIMENSION(nzb+1:nzt,nphot) :: tmp_phot 2293 REAL(kind=wp), DIMENSION(nzb+1:nzt) :: tmp_fact 2294 REAL(kind=wp), DIMENSION(nzb+1:nzt) :: tmp_fact_i !< conversion factor between 2295 !< molecules cm^{-3} and ppm 2296 2297 INTEGER,DIMENSION(nzb+1:nzt) :: nacc !< Number of accepted steps 2298 INTEGER,DIMENSION(nzb+1:nzt) :: nrej !< Number of rejected steps 2299 2300 REAL(wp) :: conv !< conversion factor 2301 REAL(wp), PARAMETER :: ppm2fr = 1.0e-6_wp !< Conversion factor ppm to fraction 2302 REAL(wp), PARAMETER :: fr2ppm = 1.0e6_wp !< Conversion factor fraction to ppm 2303 ! REAL(wp), PARAMETER :: xm_air = 28.96_wp !< Mole mass of dry air 2304 ! REAL(wp), PARAMETER :: xm_h2o = 18.01528_wp !< Mole mass of water vapor 2305 REAL(wp), PARAMETER :: t_std = 273.15_wp !< standard pressure (Pa) 2306 REAL(wp), PARAMETER :: p_std = 101325.0_wp !< standard pressure (Pa) 2307 REAL(wp), PARAMETER :: vmolcm = 22.414e3_wp !< Mole volume (22.414 l) in cm^3 2308 REAL(wp), PARAMETER :: xna = 6.022e23_wp !< Avogadro number (molecules/mol) 2309 2310 REAL(wp),DIMENSION(size(rcntrl)) :: rcntrl_local 2311 2312 REAL(kind=wp) :: dt_chem 2320 2313 2321 ! 2314 2322 !-- Set chem_gasphase_on to .FALSE. if you want to skip computation of gas phase chemistry … … 2319 2327 tmp_temp(:) = pt(nzb+1:nzt,j,i) * exner(nzb+1:nzt) 2320 2328 ! 2321 !-- convert ppm to molecules/cm**32322 !-- tmp_fact = 1.e-6_wp*6.022e23_wp/(22.414_wp*1000._wp) * 273.15_wp * 2323 !-- hyp(nzb+1:nzt)/( 101300.0_wp * tmp_temp ) 2329 !-- Convert ppm to molecules/cm**3 2330 !-- tmp_fact = 1.e-6_wp*6.022e23_wp/(22.414_wp*1000._wp) * 273.15_wp * 2331 !-- hyp(nzb+1:nzt)/( 101300.0_wp * tmp_temp ) 2324 2332 conv = ppm2fr * xna / vmolcm 2325 2333 tmp_fact(:) = conv * t_std * hyp(nzb+1:nzt) / (tmp_temp(:) * p_std) … … 2328 2336 IF ( humidity ) THEN 2329 2337 IF ( bulk_cloud_model ) THEN 2330 tmp_qvap(:) = ( q(nzb+1:nzt,j,i) - ql(nzb+1:nzt,j,i) ) * &2338 tmp_qvap(:) = ( q(nzb+1:nzt,j,i) - ql(nzb+1:nzt,j,i) ) * & 2331 2339 xm_air/xm_h2o * fr2ppm * tmp_fact(:) 2332 2340 ELSE … … 2334 2342 ENDIF 2335 2343 ELSE 2336 tmp_qvap(:) = 0.01 * xm_air/xm_h2o * fr2ppm * tmp_fact(:) !< Constant value for q if water vapor is not computed 2344 tmp_qvap(:) = 0.01 * xm_air/xm_h2o * fr2ppm * tmp_fact(:) !< Constant value for q if 2345 !< water vapor is not computed 2337 2346 ENDIF 2338 2347 2339 2348 DO lsp = 1,nspec 2340 tmp_conc(:,lsp) = chem_species(lsp)%conc(nzb+1:nzt,j,i) * tmp_fact(:) 2349 tmp_conc(:,lsp) = chem_species(lsp)%conc(nzb+1:nzt,j,i) * tmp_fact(:) 2341 2350 ENDDO 2342 2351 2343 2352 DO lph = 1,nphot 2344 tmp_phot(:,lph) = phot_frequen(lph)%freq(nzb+1:nzt,j,i) 2353 tmp_phot(:,lph) = phot_frequen(lph)%freq(nzb+1:nzt,j,i) 2345 2354 ENDDO 2346 2355 ! … … 2354 2363 cs_time_step = dt_chem 2355 2364 2356 IF (maxval(rcntrl) > 0.0) THEN ! Only if rcntrl is set2365 IF ( MAXVAL( rcntrl ) > 0.0 ) THEN ! Only if rcntrl is set 2357 2366 IF( time_since_reference_point <= 2*dt_3d) THEN 2358 2367 rcntrl_local = 0 … … 2364 2373 END IF 2365 2374 2366 CALL chem_gasphase_integrate ( dt_chem, tmp_conc, tmp_temp, tmp_qvap, tmp_fact, tmp_phot, &2375 CALL chem_gasphase_integrate ( dt_chem, tmp_conc, tmp_temp, tmp_qvap, tmp_fact, tmp_phot, & 2367 2376 icntrl_i = icntrl, rcntrl_i = rcntrl_local, xnacc = nacc, xnrej = nrej, istatus=istatus ) 2368 2377 … … 2378 2387 2379 2388 2380 !------------------------------------------------------------------------------ !2389 !--------------------------------------------------------------------------------------------------! 2381 2390 ! Description: 2382 2391 ! ------------ 2383 2392 !> Subroutine defining parin for &chemistry_parameters for chemistry model 2384 !------------------------------------------------------------------------------ !2393 !--------------------------------------------------------------------------------------------------! 2385 2394 SUBROUTINE chem_parin 2386 2395 … … 2392 2401 2393 2402 2394 CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file 2395 2396 REAL(wp), DIMENSION(nmaxfixsteps) :: my_steps !< List of fixed timesteps my_step(1) = 0.0 automatic stepping 2397 INTEGER(iwp) :: i !< 2398 INTEGER(iwp) :: max_pr_cs_tmp !< 2399 2400 2401 NAMELIST /chemistry_parameters/ bc_cs_b, & 2402 bc_cs_l, & 2403 bc_cs_n, & 2404 bc_cs_r, & 2405 bc_cs_s, & 2406 bc_cs_t, & 2407 call_chem_at_all_substeps, & 2408 chem_debug0, & 2409 chem_debug1, & 2410 chem_debug2, & 2411 chem_gasphase_on, & 2412 chem_mechanism, & 2413 cs_heights, & 2414 cs_name, & 2415 cs_profile, & 2416 cs_surface, & 2417 cs_surface_initial_change, & 2418 cs_vertical_gradient_level, & 2419 daytype_mdh, & 2420 deposition_dry, & 2421 emissions_anthropogenic, & 2422 emiss_lod, & 2423 emiss_factor_main, & 2424 emiss_factor_side, & 2425 emiss_read_legacy_mode, & 2426 icntrl, & 2427 main_street_id, & 2428 max_street_id, & 2429 mode_emis, & 2430 my_steps, & 2431 nesting_chem, & 2432 nesting_offline_chem, & 2433 rcntrl, & 2434 side_street_id, & 2435 photolysis_scheme, & 2436 wall_csflux, & 2437 cs_vertical_gradient, & 2438 top_csflux, & 2439 surface_csflux, & 2440 surface_csflux_name, & 2403 CHARACTER (LEN=80) :: line !< dummy string that contains the current 2404 !< line of the parameter file 2405 2406 INTEGER(iwp) :: i !< 2407 INTEGER(iwp) :: max_pr_cs_tmp !< 2408 2409 REAL(wp), DIMENSION(nmaxfixsteps) :: my_steps !< List of fixed timesteps my_step(1) = 0.0 2410 !< automatic stepping 2411 2412 2413 NAMELIST /chemistry_parameters/ & 2414 bc_cs_b, & 2415 bc_cs_l, & 2416 bc_cs_n, & 2417 bc_cs_r, & 2418 bc_cs_s, & 2419 bc_cs_t, & 2420 call_chem_at_all_substeps, & 2421 chem_debug0, & 2422 chem_debug1, & 2423 chem_debug2, & 2424 chem_gasphase_on, & 2425 chem_mechanism, & 2426 cs_heights, & 2427 cs_name, & 2428 cs_profile, & 2429 cs_surface, & 2430 cs_surface_initial_change, & 2431 cs_vertical_gradient_level, & 2432 daytype_mdh, & 2433 deposition_dry, & 2434 emissions_anthropogenic, & 2435 emiss_lod, & 2436 emiss_factor_main, & 2437 emiss_factor_side, & 2438 emiss_read_legacy_mode, & 2439 icntrl, & 2440 main_street_id, & 2441 max_street_id, & 2442 mode_emis, & 2443 my_steps, & 2444 nesting_chem, & 2445 nesting_offline_chem, & 2446 rcntrl, & 2447 side_street_id, & 2448 photolysis_scheme, & 2449 wall_csflux, & 2450 cs_vertical_gradient, & 2451 top_csflux, & 2452 surface_csflux, & 2453 surface_csflux_name, & 2441 2454 time_fac_type 2442 2455 ! 2443 !-- analogueto chem_names(nspj) we could invent chem_surfaceflux(nspj) and chem_topflux(nspj)2456 !-- Analogically to chem_names(nspj) we could invent chem_surfaceflux(nspj) and chem_topflux(nspj) 2444 2457 !-- so this way we could prescribe a specific flux value for each species 2445 2458 !> chemistry_parameters for initial profiles 2446 2459 !> cs_names = 'O3', 'NO2', 'NO', ... to set initial profiles) 2447 2460 !> cs_heights(1,:) = 0.0, 100.0, 500.0, 2000.0, .... (height levels where concs will be prescribed for O3) 2448 !> cs_heights(2,:) = 0.0, 200.0, 400.0, 1000.0, .... (same for NO2 etc.) 2461 !> cs_heights(2,:) = 0.0, 200.0, 400.0, 1000.0, .... (same for NO2 etc.) 2449 2462 !> cs_profiles(1,:) = 10.0, 20.0, 20.0, 30.0, ..... (chem spcs conc at height lvls chem_heights(1,:)) etc. 2450 2463 !> If the respective concentration profile should be constant with height, then use "cs_surface( number of spcs)" 2451 2464 !> then write these cs_surface values to chem_species(lsp)%conc_pr_init(:) 2452 2465 ! 2453 !-- Read chem namelist 2454 2466 !-- Read chem namelist 2455 2467 CHARACTER(LEN=8) :: solver_type 2456 2468 … … 2462 2474 rtol = 0.01_wp 2463 2475 ! 2464 !-- 2476 !-- Try to find chemistry package 2465 2477 REWIND ( 11 ) 2466 2478 line = ' ' … … 2470 2482 BACKSPACE ( 11 ) 2471 2483 ! 2472 !-- 2473 READ ( 11, chemistry_parameters, ERR = 10, END = 20 ) 2474 ! 2475 !-- 2476 air_chemistry = .TRUE. 2484 !-- Read chemistry namelist 2485 READ ( 11, chemistry_parameters, ERR = 10, END = 20 ) 2486 ! 2487 !-- Enable chemistry model 2488 air_chemistry = .TRUE. 2477 2489 GOTO 20 2478 2490 … … 2486 2498 2487 2499 ! 2488 !-- synchronize emiss_lod and mod_emis only if emissions_anthropogenic2489 !-- is activated in the namelist.Otherwise their values are "don't care"2500 !-- Synchronize emiss_lod and mod_emis only if emissions_anthropogenic is activated in the namelist. 2501 !-- Otherwise their values are "don't care" 2490 2502 IF ( emissions_anthropogenic ) THEN 2491 2503 2492 2504 ! 2493 !-- check for emission mode for chem species 2494 2505 !-- Check for emission mode for chem species 2495 2506 IF ( emiss_lod < 0 ) THEN !- if LOD not defined in namelist 2496 IF ( ( mode_emis /= 'PARAMETERIZED' ) .AND. &2497 ( mode_emis /= 'DEFAULT' ) .AND. &2507 IF ( ( mode_emis /= 'PARAMETERIZED' ) .AND. & 2508 ( mode_emis /= 'DEFAULT' ) .AND. & 2498 2509 ( mode_emis /= 'PRE-PROCESSED' ) ) THEN 2499 2510 message_string = 'Incorrect mode_emiss option select. Please check spelling' … … 2501 2512 ENDIF 2502 2513 ELSE 2503 IF ( ( emiss_lod /= 0 ) .AND. &2504 ( emiss_lod /= 1 ) .AND. &2514 IF ( ( emiss_lod /= 0 ) .AND. & 2515 ( emiss_lod /= 1 ) .AND. & 2505 2516 ( emiss_lod /= 2 ) ) THEN 2506 2517 message_string = 'Invalid value for emiss_lod (0, 1, or 2)' … … 2510 2521 2511 2522 ! 2512 ! for reference (ecc)2523 ! For reference (ecc) 2513 2524 ! IF ( (mode_emis /= 'PARAMETERIZED') .AND. ( mode_emis /= 'DEFAULT' ) .AND. ( mode_emis /= 'PRE-PROCESSED' ) ) THEN 2514 2525 ! message_string = 'Incorrect mode_emiss option select. Please check spelling' … … 2517 2528 2518 2529 ! 2519 !-- conflict resolution for emiss_lod and mode_emis2530 !-- Conflict resolution for emiss_lod and mode_emis 2520 2531 !-- 1) if emiss_lod is defined, have mode_emis assume same setting as emiss_lod 2521 2532 !-- 2) if emiss_lod it not defined, have emiss_lod assuem same setting as mode_emis 2522 !-- this check is in place to retain backward compatibility with salsa until the 2523 !-- code is migrated completed to emiss_lod 2524 !-- note that 2525 2533 !-- this check is in place to retain backward compatibility with salsa until the code is migrated 2534 !-- completed to emiss_lod 2535 !-- note that 2526 2536 IF ( emiss_lod >= 0 ) THEN 2527 2537 … … 2534 2544 mode_emis = 'PRE-PROCESSED' 2535 2545 END SELECT 2536 2537 message_string = 'Synchronizing mode_emis to defined emiss_lod' // &2538 CHAR( 10) // ' ' //&2539 'NOTE - mode_emis will be depreciated in future releases' // &2540 CHAR( 10) // ' ' //&2546 2547 message_string = 'Synchronizing mode_emis to defined emiss_lod' // & 2548 CHAR( 10 ) // ' ' // & 2549 'NOTE - mode_emis will be depreciated in future releases' // & 2550 CHAR( 10 ) // ' ' // & 2541 2551 'please use emiss_lod to define emission mode' 2542 2552 2543 2553 CALL message ( 'parin_chem', 'CM0463', 0, 0, 0, 6, 0 ) 2544 2554 … … 2554 2564 END SELECT 2555 2565 2556 message_string = 'emiss_lod undefined. Using existing mod_emiss setting' // &2557 CHAR( 10) // ' ' //&2558 'NOTE - mode_emis will be depreciated in future releases' // &2559 CHAR( 10) // ' ' //&2566 message_string = 'emiss_lod undefined. Using existing mod_emiss setting' // & 2567 CHAR( 10 ) // ' ' // & 2568 'NOTE - mode_emis will be depreciated in future releases' // & 2569 CHAR( 10 ) // ' ' // & 2560 2570 'please use emiss_lod to define emission mode' 2561 2571 … … 2576 2586 IF ( emiss_read_legacy_mode ) THEN !< notify legacy read mode 2577 2587 2578 message_string = 'Legacy emission read mode activated' // &2579 CHAR( 10) // ' ' //&2580 'All emissions data will be loaded ' // &2588 message_string = 'Legacy emission read mode activated' // & 2589 CHAR( 10 ) // ' ' // & 2590 'All emissions data will be loaded ' // & 2581 2591 'prior to start of simulation' 2582 2592 CALL message ( 'parin_chem', 'CM0465', 0, 0, 0, 6, 0 ) 2583 2593 2584 ELSE !< if new read mode selected 2594 ELSE !< if new read mode selected 2585 2595 2586 2596 IF ( emiss_lod < 2 ) THEN !< check LOD compatibility 2587 2597 2588 message_string = 'New emission read mode ' // &2589 'currently unavailable for LODs 0 and 1.' // &2590 CHAR( 10) // ' ' //&2598 message_string = 'New emission read mode ' // & 2599 'currently unavailable for LODs 0 and 1.' // & 2600 CHAR( 10 ) // ' ' // & 2591 2601 'Reverting to legacy emission read mode' 2592 2602 CALL message ( 'parin_chem', 'CM0466', 0, 0, 0, 6, 0 ) … … 2596 2606 ELSE !< notify new read mode 2597 2607 2598 message_string = 'New emission read mode activated' // &2599 CHAR( 10) // ' ' //&2600 'LOD 2 emissions will be updated on-demand ' // &2608 message_string = 'New emission read mode activated' // & 2609 CHAR( 10 ) // ' ' // & 2610 'LOD 2 emissions will be updated on-demand ' // & 2601 2611 'according to indicated timestamps' 2602 2612 CALL message ( 'parin_chem', 'CM0467', 0, 0, 0, 6, 0 ) … … 2605 2615 2606 2616 ENDIF ! if emiss_read_legacy_mode 2607 2608 2617 2618 2609 2619 ENDIF ! if emissions_anthropengic 2610 2620 2611 2621 2612 t_steps = my_steps 2613 ! 2614 !-- Determine the number of user-defined profiles and append them to the2615 ! -- standard data output(data_output_pr)2616 max_pr_cs_tmp = 0 2622 t_steps = my_steps 2623 ! 2624 !-- Determine the number of user-defined profiles and append them to the standard data output 2625 !>> (data_output_pr) 2626 max_pr_cs_tmp = 0 2617 2627 i = 1 2618 2628 … … 2628 2638 max_pr_cs = max_pr_cs_tmp 2629 2639 ENDIF 2630 2631 !Set Solver Type2640 ! 2641 !-- Set Solver Type 2632 2642 IF(icntrl(3) == 0) THEN 2633 2643 solver_type = 'rodas3' !Default … … 2676 2686 2677 2687 2678 !------------------------------------------------------------------------------ !2688 !--------------------------------------------------------------------------------------------------! 2679 2689 ! Description: 2680 2690 ! ------------ 2681 2691 !> Call for all grid points 2682 !------------------------------------------------------------------------------ !2692 !--------------------------------------------------------------------------------------------------! 2683 2693 SUBROUTINE chem_actions( location ) 2684 2694 … … 2691 2701 ! 2692 2702 !-- Chemical reactions and deposition 2693 IF ( chem_gasphase_on ) THEN2703 IF ( chem_gasphase_on ) THEN 2694 2704 ! 2695 2705 !-- If required, calculate photolysis frequencies - … … 2709 2719 2710 2720 2711 !------------------------------------------------------------------------------ !2721 !--------------------------------------------------------------------------------------------------! 2712 2722 ! Description: 2713 2723 ! ------------ 2714 2724 !> Call for grid points i,j 2715 !------------------------------------------------------------------------------ !2725 !--------------------------------------------------------------------------------------------------! 2716 2726 2717 2727 SUBROUTINE chem_actions_ij( i, j, location ) 2718 2728 2729 CHARACTER (LEN=*), INTENT(IN) :: location !< call location string 2730 2731 INTEGER(iwp) :: dummy !< call location string 2719 2732 2720 2733 INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction 2721 2734 INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction 2722 CHARACTER (LEN=*), INTENT(IN) :: location !< call location string2723 INTEGER(iwp) :: dummy !< call location string2724 2735 2725 2736 IF ( air_chemistry ) dummy = i + j … … 2736 2747 2737 2748 2738 !------------------------------------------------------------------------------ !2749 !--------------------------------------------------------------------------------------------------! 2739 2750 ! Description: 2740 2751 ! ------------ 2741 2752 !> Call for all grid points 2742 !------------------------------------------------------------------------------ !2753 !--------------------------------------------------------------------------------------------------! 2743 2754 SUBROUTINE chem_non_advective_processes() 2744 2755 … … 2747 2758 INTEGER(iwp) :: j !< 2748 2759 2749 ! 2750 !-- Calculation of chemical reactions and deposition. 2751 2752 2753 IF ( intermediate_timestep_count == 1 .OR. call_chem_at_all_substeps ) THEN 2754 2755 IF ( chem_gasphase_on ) THEN 2760 ! 2761 !-- Calculation of chemical reactions and deposition. 2762 IF ( intermediate_timestep_count == 1 .OR. call_chem_at_all_substeps ) THEN 2763 2764 IF ( chem_gasphase_on ) THEN 2756 2765 CALL cpu_log( log_point_s(19), 'chem.reactions', 'start' ) 2757 2766 !$OMP PARALLEL PRIVATE (i,j) … … 2783 2792 2784 2793 2785 !------------------------------------------------------------------------------ !2794 !--------------------------------------------------------------------------------------------------! 2786 2795 ! Description: 2787 2796 ! ------------ 2788 2797 !> Call for grid points i,j 2789 !------------------------------------------------------------------------------ !2798 !--------------------------------------------------------------------------------------------------! 2790 2799 SUBROUTINE chem_non_advective_processes_ij( i, j ) 2791 2800 … … 2796 2805 ! 2797 2806 !-- Calculation of chemical reactions and deposition. 2798 2799 2800 IF ( intermediate_timestep_count == 1 .OR. call_chem_at_all_substeps ) THEN 2801 2802 IF ( chem_gasphase_on ) THEN 2807 IF ( intermediate_timestep_count == 1 .OR. call_chem_at_all_substeps ) THEN 2808 2809 IF ( chem_gasphase_on ) THEN 2803 2810 CALL cpu_log( log_point_s(19), 'chem.reactions', 'start' ) 2804 2811 CALL chem_integrate( i, j ) … … 2817 2824 2818 2825 END SUBROUTINE chem_non_advective_processes_ij 2819 2820 !------------------------------------------------------------------------------ !2826 2827 !--------------------------------------------------------------------------------------------------! 2821 2828 ! Description: 2822 2829 ! ------------ 2823 !> routine for exchange horiz of chemical quantities 2824 !------------------------------------------------------------------------------ !2830 !> routine for exchange horiz of chemical quantities 2831 !--------------------------------------------------------------------------------------------------! 2825 2832 SUBROUTINE chem_exchange_horiz_bounds 2826 2827 USE exchange_horiz_mod, &2833 2834 USE exchange_horiz_mod, & 2828 2835 ONLY: exchange_horiz 2829 2836 2830 2837 INTEGER(iwp) :: lsp !< 2831 2832 ! 2833 !-- Loop over chemical species 2838 2839 ! 2840 !-- Loop over chemical species 2834 2841 CALL cpu_log( log_point_s(84), 'chem.exch-horiz', 'start' ) 2835 2842 DO lsp = 1, nvar … … 2845 2852 END SUBROUTINE chem_exchange_horiz_bounds 2846 2853 2847 2848 !------------------------------------------------------------------------------ !2854 2855 !--------------------------------------------------------------------------------------------------! 2849 2856 ! Description: 2850 2857 ! ------------ 2851 !> Subroutine calculating prognostic equations for chemical species 2852 !> (vector-optimized). 2853 !> Routine is called separately for each chemical species over a loop from 2854 !> prognostic_equations. 2855 !------------------------------------------------------------------------------! 2858 !> Subroutine calculating prognostic equations for chemical species (vector-optimized). 2859 !> Routine is called separately for each chemical species over a loop from prognostic_equations. 2860 !--------------------------------------------------------------------------------------------------! 2856 2861 SUBROUTINE chem_prognostic_equations() 2857 2862 … … 2945 2950 DO k = nzb+1, nzt 2946 2951 chem_species(ilsp)%tconc_m(k,j,i) = - 9.5625_wp * tend(k,j,i) & 2947 + 5.3125_wp * chem_species(ilsp)%tconc_m(k,j,i)2952 + 5.3125_wp * chem_species(ilsp)%tconc_m(k,j,i) 2948 2953 ENDDO 2949 2954 ENDDO … … 2959 2964 2960 2965 2961 !------------------------------------------------------------------------------ !2966 !--------------------------------------------------------------------------------------------------! 2962 2967 ! Description: 2963 2968 ! ------------ 2964 !> Subroutine calculating prognostic equations for chemical species 2965 !> (cache-optimized). 2966 !> Routine is called separately for each chemical species over a loop from 2967 !> prognostic_equations. 2968 !------------------------------------------------------------------------------! 2969 !> Subroutine calculating prognostic equations for chemical species (cache-optimized). 2970 !> Routine is called separately for each chemical species over a loop from prognostic_equations. 2971 !--------------------------------------------------------------------------------------------------! 2969 2972 SUBROUTINE chem_prognostic_equations_ij( i, j, i_omp_start, tn ) 2970 2973 2971 2974 2972 2975 INTEGER(iwp),INTENT(IN) :: i, j, i_omp_start, tn 2976 2973 2977 INTEGER(iwp) :: ilsp 2974 2978 ! … … 3009 3013 ! 3010 3014 !-- Diffusion terms (the last three arguments are zero) 3011 3012 3015 CALL diffusion_s( i, j, chem_species(ilsp)%conc, & 3013 3016 surf_def_h(0)%cssws(ilsp,:), surf_def_h(1)%cssws(ilsp,:), & … … 3033 3036 ) 3034 3037 3035 IF ( chem_species(ilsp)%conc_p(k,j,i) < 0.0_wp ) THEN 3036 chem_species(ilsp)%conc_p(k,j,i) = 0.1_wp * chem_species(ilsp)%conc(k,j,i) !FKS6 3038 IF ( chem_species(ilsp)%conc_p(k,j,i) < 0.0_wp ) THEN 3039 chem_species(ilsp)%conc_p(k,j,i) = 0.1_wp * chem_species(ilsp)%conc(k,j,i) !FKS6 3037 3040 ENDIF 3038 3041 ENDDO … … 3048 3051 DO k = nzb+1, nzt 3049 3052 chem_species(ilsp)%tconc_m(k,j,i) = -9.5625_wp * tend(k,j,i) + & 3050 5.3125_wp * chem_species(ilsp)%tconc_m(k,j,i)3053 5.3125_wp * chem_species(ilsp)%tconc_m(k,j,i) 3051 3054 ENDDO 3052 3055 ENDIF … … 3058 3061 3059 3062 3060 !------------------------------------------------------------------------------ !3063 !--------------------------------------------------------------------------------------------------! 3061 3064 ! Description: 3062 3065 ! ------------ 3063 3066 !> Read module-specific local restart data arrays (Fortran binary format). 3064 !------------------------------------------------------------------------------! 3065 SUBROUTINE chem_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, & 3066 nxr_on_file, nynf, nync, nyn_on_file, nysf, nysc, & 3067 nys_on_file, tmp_3d, found ) 3067 !--------------------------------------------------------------------------------------------------! 3068 SUBROUTINE chem_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, & 3069 nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found ) 3068 3070 3069 3071 USE control_parameters 3070 3072 3071 3073 INTEGER(iwp) :: k !< 3072 3074 INTEGER(iwp) :: lsp !< 3073 INTEGER(iwp) :: k !<3074 INTEGER(iwp) :: nxl c !<3075 INTEGER(iwp) :: nxl f !<3076 INTEGER(iwp) :: nx l_on_file !<3077 INTEGER(iwp) :: nxr c !<3078 INTEGER(iwp) :: nxr f !<3079 INTEGER(iwp) :: n xr_on_file !<3080 INTEGER(iwp) :: nyn c !<3081 INTEGER(iwp) :: nyn f !<3082 INTEGER(iwp) :: ny n_on_file !<3083 INTEGER(iwp) :: nys c !<3084 INTEGER(iwp) :: nys f !<3085 INTEGER(iwp) :: nys_on_file !< 3086 3087 LOGICAL, INTENT(OUT) :: found 3088 3089 REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp):: tmp_3d !< 3D array to temp store data3090 3091 3092 found = .FALSE. 3075 INTEGER(iwp) :: nxlc !< 3076 INTEGER(iwp) :: nxlf !< 3077 INTEGER(iwp) :: nxl_on_file !< 3078 INTEGER(iwp) :: nxrc !< 3079 INTEGER(iwp) :: nxrf !< 3080 INTEGER(iwp) :: nxr_on_file !< 3081 INTEGER(iwp) :: nync !< 3082 INTEGER(iwp) :: nynf !< 3083 INTEGER(iwp) :: nyn_on_file !< 3084 INTEGER(iwp) :: nysc !< 3085 INTEGER(iwp) :: nysf !< 3086 INTEGER(iwp) :: nys_on_file !< 3087 3088 LOGICAL, INTENT(OUT) :: found 3089 3090 REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) & 3091 :: tmp_3d !< 3D array to temp store data 3092 3093 3094 found = .FALSE. 3093 3095 3094 3096 … … 3123 3125 3124 3126 3125 !------------------------------------------------------------------------------ !3127 !--------------------------------------------------------------------------------------------------! 3126 3128 ! Description: 3127 3129 ! ------------ 3128 3130 !> Read module-specific local restart data arrays (Fortran binary format). 3129 !------------------------------------------------------------------------------ !3131 !--------------------------------------------------------------------------------------------------! 3130 3132 SUBROUTINE chem_rrd_local_mpi 3131 3133 … … 3154 3156 3155 3157 3156 !------------------------------------------------------------------------------- !3158 !--------------------------------------------------------------------------------------------------! 3157 3159 !> Description: 3158 3160 !> Calculation of horizontally averaged profiles … … 3160 3162 !> but at least for the region "total domain" (sr=0). 3161 3163 !> quantities. 3162 !------------------------------------------------------------------------------- !3164 !--------------------------------------------------------------------------------------------------! 3163 3165 SUBROUTINE chem_statistics( mode, sr, tn ) 3164 3166 … … 3169 3171 3170 3172 3171 CHARACTER (LEN=*) :: mode !< 3173 CHARACTER (LEN=*) :: mode !< 3172 3174 3173 3175 INTEGER(iwp) :: i !< running index on x-axis 3174 3176 INTEGER(iwp) :: j !< running index on y-axis 3175 3177 INTEGER(iwp) :: k !< vertical index counter 3178 INTEGER(iwp) :: lpr !< running index chem spcs 3176 3179 INTEGER(iwp) :: sr !< statistical region 3177 INTEGER(iwp) :: tn !< thread number 3178 INTEGER(iwp) :: lpr !< running index chem spcs 3180 INTEGER(iwp) :: tn !< thread number 3179 3181 3180 3182 IF ( mode == 'profiles' ) THEN 3181 3183 ! 3182 3184 ! 3183 !-- Sample on how to calculate horizontally averaged profiles of user- 3184 !-- defined quantities. Each quantity is identified by the index 3185 !-- "pr_palm+#" where "#" is an integer starting from 1. These 3186 !-- user-profile-numbers must also be assigned to the respective strings 3187 !-- given by data_output_pr_cs in routine user_check_data_output_pr. 3185 !-- Sample on how to calculate horizontally averaged profiles of user-defined quantities. Each 3186 !-- quantity is identified by the index "pr_palm+#" where "#" is an integer starting from 1. 3187 !-- These user-profile-numbers must also be assigned to the respective strings given by 3188 !-- data_output_pr_cs in routine user_check_data_output_pr. 3188 3189 !-- hom(:,:,:,:) = dim-1 = vertical level, dim-2= 1: met-species,2:zu/zw, dim-3 = quantity( e.g. 3189 3190 !-- w*pt*), dim-4 = statistical region. … … 3195 3196 DO lpr = 1, cs_pr_count 3196 3197 3197 sums_l(k,pr_palm+max_pr_user+lpr,tn) = sums_l(k,pr_palm+max_pr_user+lpr,tn) + 3198 chem_species(cs_pr_index(lpr))%conc(k,j,i) * &3199 rmask(j,i,sr) * &3200 MERGE( 1.0_wp, 0.0_wp, &3198 sums_l(k,pr_palm+max_pr_user+lpr,tn) = sums_l(k,pr_palm+max_pr_user+lpr,tn) + & 3199 chem_species(cs_pr_index(lpr))%conc(k,j,i) * & 3200 rmask(j,i,sr) * & 3201 MERGE( 1.0_wp, 0.0_wp, & 3201 3202 BTEST( wall_flags_total_0(k,j,i), 22 ) ) 3202 3203 ENDDO … … 3211 3212 3212 3213 3213 !------------------------------------------------------------------------------ !3214 !--------------------------------------------------------------------------------------------------! 3214 3215 ! Description: 3215 3216 ! ------------ 3216 !> Subroutine for swapping of timelevels for chemical species 3217 !> called out from subroutineswap_timelevel3218 !------------------------------------------------------------------------------ !3217 !> Subroutine for swapping of timelevels for chemical species called out from subroutine 3218 !> swap_timelevel 3219 !--------------------------------------------------------------------------------------------------! 3219 3220 3220 3221 … … 3224 3225 INTEGER(iwp), INTENT(IN) :: level 3225 3226 ! 3226 !-- local variables3227 !-- Local variables 3227 3228 INTEGER(iwp) :: lsp 3228 3229 3229 3230 3230 3231 IF ( level == 0 ) THEN 3231 DO lsp=1, nvar 3232 DO lsp=1, nvar 3232 3233 chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_1(:,:,:,lsp) 3233 3234 chem_species(lsp)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_2(:,:,:,lsp) 3234 3235 ENDDO 3235 3236 ELSE 3236 DO lsp=1, nvar 3237 DO lsp=1, nvar 3237 3238 chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_2(:,:,:,lsp) 3238 3239 chem_species(lsp)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_1(:,:,:,lsp) … … 3244 3245 3245 3246 3246 !------------------------------------------------------------------------------ !3247 !--------------------------------------------------------------------------------------------------! 3247 3248 ! Description: 3248 3249 ! ------------ 3249 3250 !> Subroutine to write restart data for chemistry model 3250 !------------------------------------------------------------------------------ !3251 !--------------------------------------------------------------------------------------------------! 3251 3252 SUBROUTINE chem_wrd_local 3252 3253 3253 3254 3254 INTEGER(iwp) :: lsp !< running index for chem spcs. 3255 INTEGER(iwp) :: lsp !< running index for chem spcs. 3255 3256 3256 3257 IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN … … 3279 3280 3280 3281 3281 !------------------------------------------------------------------------------- !3282 !--------------------------------------------------------------------------------------------------! 3282 3283 ! Description: 3283 3284 ! ------------ 3284 !> Subroutine to calculate the deposition of gases and PMs. For now deposition 3285 !> only takes place on lsm and usm horizontal surfaces. Default surfaces are NOT3286 !> considered. The deposition of particles is derived following Zhang et al.,3287 !> 2001, gases are deposited using the DEPAC module(van Zanten et al., 2010).3288 !> 3289 !> @TODO: Consider deposition on vertical surfaces 3285 !> Subroutine to calculate the deposition of gases and PMs. For now deposition only takes place on 3286 !> lsm and usm horizontal surfaces. Default surfaces are NOT considered. The deposition of particles 3287 !> is derived following Zhang et al., 2001, gases are deposited using the DEPAC module 3288 !> (van Zanten et al., 2010). 3289 !> 3290 !> @TODO: Consider deposition on vertical surfaces 3290 3291 !> @TODO: Consider overlaying horizontal surfaces 3291 !> @TODO: Consider resolved vegetation 3292 !> @TODO: Consider resolved vegetation 3292 3293 !> @TODO: Check error messages 3293 !------------------------------------------------------------------------------- !3294 !--------------------------------------------------------------------------------------------------! 3294 3295 SUBROUTINE chem_depo( i, j ) 3295 3296 3296 USE control_parameters, & 3297 ONLY: dt_3d, intermediate_timestep_count, latitude, & 3298 time_since_reference_point 3299 3300 USE arrays_3d, & 3297 USE control_parameters, & 3298 ONLY: dt_3d, intermediate_timestep_count, latitude, time_since_reference_point 3299 3300 USE arrays_3d, & 3301 3301 ONLY: dzw, rho_air_zw 3302 3302 3303 USE palm_date_time_mod, &3303 USE palm_date_time_mod, & 3304 3304 ONLY: get_date_time 3305 3305 3306 USE surface_mod, & 3307 ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_lsm_h, & 3308 surf_type, surf_usm_h 3309 3310 USE radiation_model_mod, & 3306 USE surface_mod, & 3307 ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_lsm_h, surf_type, surf_usm_h 3308 3309 USE radiation_model_mod, & 3311 3310 ONLY: cos_zenith 3312 3311 … … 3314 3313 INTEGER(iwp) :: day_of_year !< current day of the year 3315 3314 INTEGER(iwp), INTENT(IN) :: i 3315 INTEGER(iwp) :: i_pspec !< index for matching depac gas component 3316 3316 INTEGER(iwp), INTENT(IN) :: j 3317 3317 INTEGER(iwp) :: k !< matching k to surface m at i,j 3318 3318 INTEGER(iwp) :: lsp !< running index for chem spcs. 3319 INTEGER(iwp) :: luv_palm !< index of PALM LSM vegetation_type at current surface element 3320 INTEGER(iwp) :: lup_palm !< index of PALM LSM pavement_type at current surface element 3321 INTEGER(iwp) :: luw_palm !< index of PALM LSM water_type at current surface element 3322 INTEGER(iwp) :: luu_palm !< index of PALM USM walls/roofs at current surface element 3323 INTEGER(iwp) :: lug_palm !< index of PALM USM green walls/roofs at current surface element 3324 INTEGER(iwp) :: lud_palm !< index of PALM USM windows at current surface element 3319 INTEGER(iwp) :: luv_palm !< index of PALM LSM vegetation_type at current 3320 !< surface element 3321 INTEGER(iwp) :: lup_palm !< index of PALM LSM pavement_type at current 3322 !< surface element 3323 INTEGER(iwp) :: luw_palm !< index of PALM LSM water_type at current 3324 !< surface element 3325 INTEGER(iwp) :: luu_palm !< index of PALM USM walls/roofs at current 3326 !< surface element 3327 INTEGER(iwp) :: lug_palm !< index of PALM USM green walls/roofs at current 3328 !< surface element 3329 INTEGER(iwp) :: lud_palm !< index of PALM USM windows at current surface 3330 !< element 3325 3331 INTEGER(iwp) :: luv_dep !< matching DEPAC LU to luv_palm 3326 3332 INTEGER(iwp) :: lup_dep !< matching DEPAC LU to lup_palm … … 3330 3336 INTEGER(iwp) :: lud_dep !< matching DEPAC LU to lud_palm 3331 3337 INTEGER(iwp) :: m !< index for horizontal surfaces 3332 3333 3338 INTEGER(iwp) :: pspec !< running index 3334 INTEGER(iwp) :: i_pspec !< index for matching depac gas component 3335 ! 3336 !-- Vegetation !< Assign PALM classes to DEPAC landuse classes3337 INTEGER(iwp) :: ind_luv_user = 0 !< ERROR as no class given in PALM 3339 ! 3340 !-- Vegetation !< Assign PALM classes to DEPAC land 3341 !< use classes 3342 INTEGER(iwp) :: ind_luv_user = 0 !< ERROR as no class given in PALM 3338 3343 INTEGER(iwp) :: ind_luv_b_soil = 1 !< assigned to ilu_desert 3339 3344 INTEGER(iwp) :: ind_luv_mixed_crops = 2 !< assigned to ilu_arable … … 3352 3357 INTEGER(iwp) :: ind_luv_ev_shrubs = 15 !< assigned to ilu_mediterrean_scrub 3353 3358 INTEGER(iwp) :: ind_luv_de_shrubs = 16 !< assigned to ilu_mediterrean_scrub 3354 INTEGER(iwp) :: ind_luv_mixed_forest = 17 !< assigned to ilu_coniferous_forest 3359 INTEGER(iwp) :: ind_luv_mixed_forest = 17 !< assigned to ilu_coniferous_forest(ave(decid+conif)) 3355 3360 INTEGER(iwp) :: ind_luv_intrup_forest = 18 !< assigned to ilu_other (ave(other+decid)) 3356 3361 ! 3357 3362 !-- Water 3358 INTEGER(iwp) :: ind_luw_user = 0 !< ERROR as no class given in PALM 3363 INTEGER(iwp) :: ind_luw_user = 0 !< ERROR as no class given in PALM 3359 3364 INTEGER(iwp) :: ind_luw_lake = 1 !< assigned to ilu_water_inland 3360 3365 INTEGER(iwp) :: ind_luw_river = 2 !< assigned to ilu_water_inland 3361 3366 INTEGER(iwp) :: ind_luw_ocean = 3 !< assigned to ilu_water_sea 3362 3367 INTEGER(iwp) :: ind_luw_pond = 4 !< assigned to ilu_water_inland 3363 INTEGER(iwp) :: ind_luw_fountain = 5 !< assigned to ilu_water_inland 3368 INTEGER(iwp) :: ind_luw_fountain = 5 !< assigned to ilu_water_inland 3364 3369 ! 3365 3370 !-- Pavement … … 3369 3374 INTEGER(iwp) :: ind_lup_conc = 3 !< assigned to ilu_desert 3370 3375 INTEGER(iwp) :: ind_lup_sett = 4 !< assigned to ilu_desert 3371 INTEGER(iwp) :: ind_lup_pav_stones = 5 !< assigned to ilu_desert 3376 INTEGER(iwp) :: ind_lup_pav_stones = 5 !< assigned to ilu_desert 3372 3377 INTEGER(iwp) :: ind_lup_cobblest = 6 !< assigned to ilu_desert 3373 3378 INTEGER(iwp) :: ind_lup_metal = 7 !< assigned to ilu_desert 3374 3379 INTEGER(iwp) :: ind_lup_wood = 8 !< assigned to ilu_desert 3375 INTEGER(iwp) :: ind_lup_gravel = 9 !< assigned to ilu_desert 3380 INTEGER(iwp) :: ind_lup_gravel = 9 !< assigned to ilu_desert 3376 3381 INTEGER(iwp) :: ind_lup_f_gravel = 10 !< assigned to ilu_desert 3377 3382 INTEGER(iwp) :: ind_lup_pebblest = 11 !< assigned to ilu_desert … … 3385 3390 INTEGER(iwp) :: ind_p_dens = 2 !< index for rhopart in particle_pars 3386 3391 INTEGER(iwp) :: ind_p_slip = 3 !< index for slipcor in particle_pars 3387 3392 INTEGER(iwp) :: nwet !< wetness indicator dor DEPAC; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow 3388 3393 INTEGER(iwp) :: part_type !< index for particle type (PM10 or PM25) in particle_pars 3389 3394 3390 INTEGER(iwp) :: nwet !< wetness indicator dor DEPAC; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow 3391 3392 REAL(wp) :: dt_chem !< length of chem time step 3393 REAL(wp) :: dh !< vertical grid size 3394 REAL(wp) :: inv_dh !< inverse of vertical grid size 3395 REAL(wp) :: dt_dh !< dt_chem/dh 3396 3397 REAL(wp) :: dens !< density at layer k at i,j 3395 3396 REAL(wp) :: conc_ijk_ugm3 !< concentration at i, j, k in ug/m3 3397 REAL(wp) :: dens !< density at layer k at i,j 3398 REAL(wp) :: dh !< vertical grid size 3399 REAL(wp) :: diffusivity !< diffusivity 3400 REAL(wp) :: dt_chem !< length of chem time step 3401 REAL(wp) :: dt_dh !< dt_chem/dh 3402 REAL(wp) :: inv_dh !< inverse of vertical grid size 3403 REAL(wp) :: lai !< leaf area index at current surface element 3404 REAL(wp) :: ppm2ugm3 !< conversion factor from ppm to ug/m3 3405 REAL(wp) :: qv_tmp !< surface mixing ratio at current surface element 3398 3406 REAL(wp) :: r_aero_surf !< aerodynamic resistance (s/m) at current surface element 3407 REAL(wp) :: rb !< quasi-laminar boundary layer resistance (s/m) 3408 REAL(wp) :: rc_tot !< total canopy resistance (s/m) 3409 REAL(wp) :: rh_surf !< relative humidity at current surface element 3410 REAL(wp) :: rs !< Sedimentaion resistance (s/m) 3411 REAL(wp) :: sai !< surface area index at current surface element assumed to be 3412 !< lai + 1 3413 REAL(wp) :: slinnfac 3414 REAL(wp) :: solar_rad !< solar radiation, direct and diffuse, at current surface 3415 !< element 3416 REAL(wp) :: temp_tmp !< temperatur at i,j,k 3417 REAL(wp) :: ts !< surface temperatur in degrees celsius 3399 3418 REAL(wp) :: ustar_surf !< ustar at current surface element 3400 REAL(wp) :: z0h_surf !< roughness length for heat at current surface element 3401 REAL(wp) :: solar_rad !< solar radiation, direct and diffuse, at current surface element 3402 REAL(wp) :: ppm2ugm3 !< conversion factor from ppm to ug/m3 3403 REAL(wp) :: rh_surf !< relative humidity at current surface element 3404 REAL(wp) :: lai !< leaf area index at current surface element 3405 REAL(wp) :: sai !< surface area index at current surface element assumed to be lai + 1 3406 3407 REAL(wp) :: slinnfac 3419 REAL(wp) :: vd_lu !< deposition velocity (m/s) 3408 3420 REAL(wp) :: visc !< Viscosity 3409 3421 REAL(wp) :: vs !< Sedimentation velocity 3410 REAL(wp) :: vd_lu !< deposition velocity (m/s) 3411 REAL(wp) :: rs !< Sedimentaion resistance (s/m) 3412 REAL(wp) :: rb !< quasi-laminar boundary layer resistance (s/m) 3413 REAL(wp) :: rc_tot !< total canopy resistance (s/m) 3414 3415 REAL(wp) :: conc_ijk_ugm3 !< concentration at i, j, k in ug/m3 3416 REAL(wp) :: diffusivity !< diffusivity 3417 3418 3419 REAL(wp), DIMENSION(nspec) :: bud_luv !< budget for LSM vegetation type at current surface element 3420 REAL(wp), DIMENSION(nspec) :: bud_lup !< budget for LSM pavement type at current surface element 3421 REAL(wp), DIMENSION(nspec) :: bud_luw !< budget for LSM water type at current surface element 3422 REAL(wp), DIMENSION(nspec) :: bud_luu !< budget for USM walls/roofs at current surface element 3423 REAL(wp), DIMENSION(nspec) :: bud_lug !< budget for USM green surfaces at current surface element 3422 REAL(wp) :: z0h_surf !< roughness length for heat at current surface element 3423 3424 REAL(wp), DIMENSION(nspec) :: bud !< overall budget at current surface element 3424 3425 REAL(wp), DIMENSION(nspec) :: bud_lud !< budget for USM windows at current surface element 3425 REAL(wp), DIMENSION(nspec) :: bud !< overall budget at current surface element 3426 REAL(wp), DIMENSION(nspec) :: bud_lug !< budget for USM green surfaces at current surface 3427 !< element 3428 REAL(wp), DIMENSION(nspec) :: bud_lup !< budget for LSM pavement type at current surface 3429 !< element 3430 REAL(wp), DIMENSION(nspec) :: bud_luu !< budget for USM walls/roofs at current surface 3431 !< element 3432 REAL(wp), DIMENSION(nspec) :: bud_luv !< budget for LSM vegetation type at current surface 3433 !< element 3434 REAL(wp), DIMENSION(nspec) :: bud_luw !< budget for LSM water type at current surface 3435 !< element 3436 REAL(wp), DIMENSION(nspec) :: ccomp_tot !< total compensation point (ug/m3), for now kept to 3437 !< zero for all species! 3426 3438 REAL(wp), DIMENSION(nspec) :: conc_ijk !< concentration at i,j,k 3427 REAL(wp), DIMENSION(nspec) :: ccomp_tot !< total compensation point (ug/m3), for now kept to zero for all species! 3428 3429 3430 REAL(wp) :: temp_tmp !< temperatur at i,j,k 3431 REAL(wp) :: ts !< surface temperatur in degrees celsius 3432 REAL(wp) :: qv_tmp !< surface mixing ratio at current surface element 3433 ! 3434 !-- Particle parameters (PM10 (1), PM25 (2)) 3435 !-- partsize (diameter in m), rhopart (density in kg/m3), slipcor 3436 !-- (slip correction factor dimensionless, Seinfeld and Pandis 2006, Table 9.3) 3437 REAL(wp), DIMENSION(1:3,1:2), PARAMETER :: particle_pars = RESHAPE( (/ & 3438 8.0e-6_wp, 1.14e3_wp, 1.016_wp, & !< 1 3439 0.7e-6_wp, 1.14e3_wp, 1.082_wp & !< 2 3440 /), (/ 3, 2 /) ) 3441 3439 3440 3441 ! 3442 !-- Particle parameters (PM10 (1), PM25 (2)) partsize (diameter in m), rhopart (density in kg/m3), 3443 !-- slipcor (slip correction factor dimensionless, Seinfeld and Pandis 2006, Table 9.3) 3442 3444 LOGICAL :: match_lsm !< flag indicating natural-type surface 3443 3445 LOGICAL :: match_usm !< flag indicating urban-type surface 3446 3447 REAL(wp), DIMENSION(1:3,1:2), PARAMETER :: particle_pars = RESHAPE( (/ & 3448 8.0e-6_wp, 1.14e3_wp, 1.016_wp, & !< 1 3449 0.7e-6_wp, 1.14e3_wp, 1.082_wp & !< 2 3450 /), (/ 3, 2 /) ) 3444 3451 ! 3445 3452 !-- List of names of possible tracers 3446 CHARACTER(LEN=*), PARAMETER :: pspecnames(nposp) = (/ &3453 CHARACTER(LEN=*), PARAMETER :: pspecnames(nposp) = (/ & 3447 3454 'NO2 ', & !< NO2 3448 3455 'NO ', & !< NO … … 3515 3522 'O3_biascorr ' /) !< o3_biascorr 3516 3523 ! 3517 !-- tracer mole mass:3518 REAL(wp), PARAMETER :: specmolm(nposp) = (/ &3524 !-- Tracer mole mass: 3525 REAL(wp), PARAMETER :: specmolm(nposp) = (/ & 3519 3526 xm_O * 2 + xm_N, & !< NO2 3520 3527 xm_O + xm_N, & !< NO … … 3600 3607 ! 3601 3608 !--For LSM surfaces 3602 3603 3609 IF ( match_lsm ) THEN 3604 3610 ! … … 3612 3618 r_aero_surf = surf_lsm_h%r_a(m) 3613 3619 solar_rad = surf_lsm_h%rad_sw_dir(m) + surf_lsm_h%rad_sw_dif(m) 3614 3620 3615 3621 lai = surf_lsm_h%lai(m) 3616 3622 sai = lai + 1 … … 3628 3634 luw_palm = 0 3629 3635 luw_dep = 0 3630 ! 3636 ! 3631 3637 !-- Initialize budgets 3632 3638 bud_luv = 0.0_wp … … 3675 3681 luv_dep = 4 3676 3682 ELSEIF ( luv_palm == ind_luv_intrup_forest ) THEN 3677 luv_dep = 8 3683 luv_dep = 8 3678 3684 ENDIF 3679 3685 ENDIF … … 3695 3701 lup_dep = 9 3696 3702 ELSEIF ( lup_palm == ind_lup_cobblest ) THEN 3697 lup_dep = 9 3703 lup_dep = 9 3698 3704 ELSEIF ( lup_palm == ind_lup_metal ) THEN 3699 3705 lup_dep = 9 3700 3706 ELSEIF ( lup_palm == ind_lup_wood ) THEN 3701 lup_dep = 9 3707 lup_dep = 9 3702 3708 ELSEIF ( lup_palm == ind_lup_gravel ) THEN 3703 3709 lup_dep = 9 … … 3718 3724 3719 3725 IF ( surf_lsm_h%frac(m,ind_wat_win) > 0 ) THEN 3720 luw_palm = surf_lsm_h%water_type(m) 3726 luw_palm = surf_lsm_h%water_type(m) 3721 3727 IF ( luw_palm == ind_luw_user ) THEN 3722 3728 message_string = 'No water type defined. Please define water type to enable deposition calculation' … … 3731 3737 luw_dep = 13 3732 3738 ELSEIF ( luw_palm == ind_luw_fountain ) THEN 3733 luw_dep = 13 3739 luw_dep = 13 3734 3740 ENDIF 3735 3741 ENDIF … … 3742 3748 ENDIF 3743 3749 ! 3744 !-- Compute length of time step 3750 !-- Compute length of time step 3745 3751 IF ( call_chem_at_all_substeps ) THEN 3746 3752 dt_chem = dt_3d * weight_pres(intermediate_timestep_count) … … 3770 3776 ! 3771 3777 !-- Calculate relative humidity from specific humidity for DEPAC 3772 qv_tmp = MAX( q(k,j,i),0.0_wp)3778 qv_tmp = MAX( q(k,j,i), 0.0_wp) 3773 3779 rh_surf = relativehumidity_from_specifichumidity(qv_tmp, temp_tmp, hyp(k) ) 3774 3780 ! … … 3781 3787 ! 3782 3788 !-- No vegetation on bare soil, desert or ice: 3783 IF ( ( luv_palm == ind_luv_b_soil ) .OR. & 3784 ( luv_palm == ind_luv_desert ) .OR. & 3785 ( luv_palm == ind_luv_ice ) ) THEN 3789 IF ( ( luv_palm == ind_luv_b_soil ) .OR. ( luv_palm == ind_luv_desert ) .OR. & 3790 ( luv_palm == ind_luv_ice ) ) THEN 3786 3791 3787 3792 lai = 0.0_wp … … 3789 3794 3790 3795 ENDIF 3791 3796 3792 3797 slinnfac = 1.0_wp 3793 3798 ! … … 3795 3800 DO lsp = 1, nvar 3796 3801 ! 3797 !-- Initialize 3802 !-- Initialize 3798 3803 vs = 0.0_wp 3799 3804 vd_lu = 0.0_wp … … 3805 3810 ! 3806 3811 !-- Sedimentation velocity 3807 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 3808 particle_pars(ind_p_size, part_type), & 3809 particle_pars(ind_p_slip, part_type), & 3810 visc) 3811 3812 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 3813 vs, & 3814 particle_pars(ind_p_size, part_type), & 3815 particle_pars(ind_p_slip, part_type), & 3816 nwet, temp_tmp, dens, visc, & 3817 luv_dep, & 3818 r_aero_surf, ustar_surf ) 3819 3820 bud_luv(lsp) = - conc_ijk(lsp) * & 3821 (1.0_wp - exp(-vd_lu * dt_dh )) * dh 3812 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 3813 particle_pars(ind_p_size, part_type), & 3814 particle_pars(ind_p_slip, part_type), & 3815 visc) 3816 3817 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 3818 vs, & 3819 particle_pars(ind_p_size, part_type), & 3820 particle_pars(ind_p_slip, part_type), & 3821 nwet, temp_tmp, dens, visc, & 3822 luv_dep, & 3823 r_aero_surf, ustar_surf ) 3824 3825 bud_luv(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 3822 3826 3823 3827 … … 3826 3830 ! 3827 3831 !-- Sedimentation velocity 3828 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 3829 particle_pars(ind_p_size, part_type), & 3830 particle_pars(ind_p_slip, part_type), & 3831 visc) 3832 3833 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 3834 vs, & 3835 particle_pars(ind_p_size, part_type), & 3836 particle_pars(ind_p_slip, part_type), & 3837 nwet, temp_tmp, dens, visc, & 3838 luv_dep , & 3839 r_aero_surf, ustar_surf ) 3840 3841 bud_luv(lsp) = - conc_ijk(lsp) * & 3842 (1.0_wp - exp(-vd_lu * dt_dh )) * dh 3832 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 3833 particle_pars(ind_p_size, part_type), & 3834 particle_pars(ind_p_slip, part_type), & 3835 visc) 3836 3837 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 3838 vs, & 3839 particle_pars(ind_p_size, part_type), & 3840 particle_pars(ind_p_slip, part_type), & 3841 nwet, temp_tmp, dens, visc, & 3842 luv_dep , & 3843 r_aero_surf, ustar_surf ) 3844 3845 bud_luv(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 3843 3846 3844 3847 ELSE !< GASES … … 3866 3869 !-- c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm3 3867 3870 !-- Use density at k: 3868 3869 3871 ppm2ugm3 = (dens/xm_air) * 0.001_wp !< (mole air)/m3 3870 3872 ! … … 3874 3876 ! 3875 3877 !-- Diffusivity for DEPAC relevant gases 3876 !-- Use default value 3878 !-- Use default value 3877 3879 diffusivity = 0.11e-4 3878 3880 ! 3879 !-- overwrite with known coefficients of diffusivity from Massman (1998)3880 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4 3881 !-- Overwrite with known coefficients of diffusivity from Massman (1998) 3882 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4 3881 3883 IF ( spc_names(lsp) == 'NO' ) diffusivity = 0.199e-4 3882 3884 IF ( spc_names(lsp) == 'O3' ) diffusivity = 0.144e-4 … … 3887 3889 ! 3888 3890 !-- Get quasi-laminar boundary layer resistance rb: 3889 CALL get_rb_cell( ( luv_dep == ilu_water_sea) .OR. (luv_dep == ilu_water_inland),&3890 z0h_surf, ustar_surf, diffusivity,&3891 rb )3891 CALL get_rb_cell( ( luv_dep == ilu_water_sea ) .OR. & 3892 ( luv_dep == ilu_water_inland ), z0h_surf, ustar_surf, & 3893 diffusivity, rb ) 3892 3894 ! 3893 3895 !-- Get rc_tot 3894 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, solar_rad, cos_zenith, & 3895 rh_surf, lai, sai, nwet, luv_dep, 2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, diffusivity, & 3896 r_aero_surf , rb ) 3896 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, & 3897 solar_rad, cos_zenith, rh_surf, lai, sai, nwet, luv_dep, & 3898 2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, & 3899 diffusivity, r_aero_surf , rb ) 3897 3900 ! 3898 3901 !-- Calculate budget … … 3903 3906 ELSE 3904 3907 3905 vd_lu = 1.0_wp / ( r_aero_surf + rb + rc_tot )3906 3907 bud_luv(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp)) *&3908 (1.0_wp - exp(-vd_lu * dt_dh )) * dh3908 vd_lu = 1.0_wp / ( r_aero_surf + rb + rc_tot ) 3909 3910 bud_luv(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) * & 3911 ( 1.0_wp - EXP( -vd_lu * dt_dh ) ) * dh 3909 3912 ENDIF 3910 3913 … … 3935 3938 ! 3936 3939 !-- Sedimentation velocity: 3937 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 3938 particle_pars(ind_p_size, part_type), & 3939 particle_pars(ind_p_slip, part_type), & 3940 visc) 3941 3942 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 3943 vs, & 3944 particle_pars(ind_p_size, part_type), & 3945 particle_pars(ind_p_slip, part_type), & 3946 nwet, temp_tmp, dens, visc, & 3947 lup_dep, & 3948 r_aero_surf, ustar_surf ) 3949 3950 bud_lup(lsp) = - conc_ijk(lsp) * & 3951 (1.0_wp - exp(-vd_lu * dt_dh )) * dh 3940 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 3941 particle_pars(ind_p_size, part_type), & 3942 particle_pars(ind_p_slip, part_type), & 3943 visc) 3944 3945 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 3946 vs, & 3947 particle_pars(ind_p_size, part_type), & 3948 particle_pars(ind_p_slip, part_type), & 3949 nwet, temp_tmp, dens, visc, & 3950 lup_dep, & 3951 r_aero_surf, ustar_surf ) 3952 3953 bud_lup(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 3952 3954 3953 3955 … … 3956 3958 ! 3957 3959 !-- Sedimentation velocity: 3958 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 3959 particle_pars(ind_p_size, part_type), & 3960 particle_pars(ind_p_slip, part_type), & 3961 visc) 3962 3963 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 3964 vs, & 3965 particle_pars(ind_p_size, part_type), & 3966 particle_pars(ind_p_slip, part_type), & 3967 nwet, temp_tmp, dens, visc, & 3968 lup_dep, & 3969 r_aero_surf, ustar_surf ) 3970 3971 bud_lup(lsp) = - conc_ijk(lsp) * & 3972 (1.0_wp - exp(-vd_lu * dt_dh )) * dh 3960 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 3961 particle_pars(ind_p_size, part_type), & 3962 particle_pars(ind_p_slip, part_type), & 3963 visc) 3964 3965 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 3966 vs, & 3967 particle_pars(ind_p_size, part_type), & 3968 particle_pars(ind_p_slip, part_type), & 3969 nwet, temp_tmp, dens, visc, & 3970 lup_dep, & 3971 r_aero_surf, ustar_surf ) 3972 3973 bud_lup(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 3973 3974 3974 3975 ELSE !<GASES 3975 3976 ! 3976 3977 !-- Read spc_name of current species for gas parameter 3977 3978 IF ( ANY( pspecnames(:) == spc_names(lsp) ) ) THEN 3979 i_pspec = 0 3980 DO pspec = 1, nposp 3981 IF ( pspecnames(pspec) == spc_names(lsp) ) THEN 3982 i_pspec = pspec 3983 END IF 3984 ENDDO 3985 3986 ELSE 3987 ! 3988 !-- For now species not deposited 3989 CYCLE 3990 ENDIF 3991 ! 3992 !-- Factor used for conversion from ppb to ug/m3 : 3993 !-- ppb (mole tr)/(mole air)/ppb (kg tr)/(mole tr) (ug tr)/(kg tr) & 3994 !-- (mole air)/(kg air) (kg air)/(m3 air) (kg air(ug/m3)/ppb/(kg/mole) = / (kg/mole) 3995 !-- c 1e-9 xm_tracer 1e9 / xm_air dens 3996 !-- thus: 3997 !-- c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm3 3998 !-- Use density at lowest layer: 3999 ppm2ugm3 = (dens/xm_air) * 0.001_wp !< (mole air)/m3 4000 ! 4001 !-- Atmospheric concentration in DEPAC is requested in ug/m3: 4002 ! ug/m3 ppm (ug/m3)/ppm/(kg/mole) kg/mole 4003 conc_ijk_ugm3 = conc_ijk(lsp) * ppm2ugm3 * specmolm(i_pspec) ! in ug/m3 4004 ! 4005 !-- Diffusivity for DEPAC relevant gases 4006 !-- Use default value 4007 diffusivity = 0.11e-4 4008 ! 4009 !-- Overwrite with known coefficients of diffusivity from Massman (1998) 4010 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4 4011 IF ( spc_names(lsp) == 'NO' ) diffusivity = 0.199e-4 4012 IF ( spc_names(lsp) == 'O3' ) diffusivity = 0.144e-4 4013 IF ( spc_names(lsp) == 'CO' ) diffusivity = 0.176e-4 4014 IF ( spc_names(lsp) == 'SO2' ) diffusivity = 0.112e-4 4015 IF ( spc_names(lsp) == 'CH4' ) diffusivity = 0.191e-4 4016 IF ( spc_names(lsp) == 'NH3' ) diffusivity = 0.191e-4 4017 ! 4018 !-- Get quasi-laminar boundary layer resistance rb: 4019 CALL get_rb_cell( ( lup_dep == ilu_water_sea ) .OR. & 4020 ( lup_dep == ilu_water_inland ), z0h_surf, ustar_surf, & 4021 diffusivity, rb ) 4022 ! 4023 !-- Get rc_tot 4024 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, & 4025 solar_rad, cos_zenith, rh_surf, lai, sai, nwet, lup_dep, & 4026 2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, & 4027 diffusivity, r_aero_surf , rb ) 4028 ! 4029 !-- Calculate budget 4030 IF ( rc_tot <= 0.0 ) THEN 4031 bud_lup(lsp) = 0.0_wp 4032 ELSE 4033 vd_lu = 1.0_wp / (r_aero_surf + rb + rc_tot ) 4034 bud_lup(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) * & 4035 ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4036 ENDIF 4037 4038 ENDIF 4039 ENDDO 4040 ENDIF 4041 ! 4042 !-- Water 4043 IF ( surf_lsm_h%frac(m,ind_wat_win) > 0 ) THEN 4044 ! 4045 !-- No vegetation on water: 4046 lai = 0.0_wp 4047 sai = 0.0_wp 4048 slinnfac = 1.0_wp 4049 ! 4050 !-- Get vd 4051 DO lsp = 1, nvar 4052 ! 4053 !-- Initialize 4054 vs = 0.0_wp 4055 vd_lu = 0.0_wp 4056 rs = 0.0_wp 4057 rb = 0.0_wp 4058 rc_tot = 0.0_wp 4059 IF ( spc_names(lsp) == 'PM10' ) THEN 4060 part_type = 1 4061 ! 4062 !-- Sedimentation velocity: 4063 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4064 particle_pars(ind_p_size, part_type), & 4065 particle_pars(ind_p_slip, part_type), & 4066 visc) 4067 4068 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 4069 vs, & 4070 particle_pars(ind_p_size, part_type), & 4071 particle_pars(ind_p_slip, part_type), & 4072 nwet, temp_tmp, dens, visc, & 4073 luw_dep, & 4074 r_aero_surf, ustar_surf ) 4075 4076 bud_luw(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4077 4078 ELSEIF ( spc_names(lsp) == 'PM25' ) THEN 4079 part_type = 2 4080 ! 4081 !-- Sedimentation velocity: 4082 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4083 particle_pars(ind_p_size, part_type), & 4084 particle_pars(ind_p_slip, part_type), & 4085 visc) 4086 4087 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 4088 vs, & 4089 particle_pars(ind_p_size, part_type), & 4090 particle_pars(ind_p_slip, part_type), & 4091 nwet, temp_tmp, dens, visc, & 4092 luw_dep, & 4093 r_aero_surf, ustar_surf ) 4094 4095 bud_luw(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4096 4097 ELSE !<GASES 4098 ! 4099 !-- Read spc_name of current species for gas PARAMETER 3978 4100 IF ( ANY(pspecnames(:) == spc_names(lsp) ) ) THEN 3979 4101 i_pspec = 0 … … 3997 4119 !-- c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm3 3998 4120 !-- Use density at lowest layer: 3999 4000 ppm2ugm3 = (dens/xm_air) * 0.001_wp !< (mole air)/m3 4121 ppm2ugm3 = (dens/xm_air) * 0.001_wp !< (mole air)/m3 4001 4122 ! 4002 4123 !-- Atmospheric concentration in DEPAC is requested in ug/m3: 4003 ! ug/m3ppm (ug/m3)/ppm/(kg/mole) kg/mole4004 conc_ijk_ugm3 = conc_ijk(lsp) * ppm2ugm3 *specmolm(i_pspec) ! in ug/m34124 !-- ug/m3 ppm (ug/m3)/ppm/(kg/mole) kg/mole 4125 conc_ijk_ugm3 = conc_ijk(lsp) * ppm2ugm3 * specmolm(i_pspec) ! in ug/m3 4005 4126 ! 4006 4127 !-- Diffusivity for DEPAC relevant gases 4007 !-- Use default value 4128 !-- Use default value 4008 4129 diffusivity = 0.11e-4 4009 4130 ! 4010 !-- overwrite with known coefficients of diffusivity from Massman (1998)4011 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4 4131 !-- Overwrite with known coefficients of diffusivity from Massman (1998) 4132 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4 4012 4133 IF ( spc_names(lsp) == 'NO' ) diffusivity = 0.199e-4 4013 4134 IF ( spc_names(lsp) == 'O3' ) diffusivity = 0.144e-4 … … 4018 4139 ! 4019 4140 !-- Get quasi-laminar boundary layer resistance rb: 4020 CALL get_rb_cell( (lup_dep == ilu_water_sea) .OR. (lup_dep == ilu_water_inland), & 4021 z0h_surf, ustar_surf, diffusivity, rb ) 4022 ! 4141 CALL get_rb_cell( ( luw_dep == ilu_water_sea ) .OR. & 4142 ( luw_dep == ilu_water_inland ), z0h_surf, ustar_surf, & 4143 diffusivity, rb ) 4144 4023 4145 !-- Get rc_tot 4024 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, 4025 solar_rad, cos_zenith, rh_surf, lai, sai, nwet, lu p_dep, 2,&4026 rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, diffusivity,&4027 r_aero_surf , rb )4146 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, & 4147 solar_rad, cos_zenith, rh_surf, lai, sai, nwet, luw_dep, & 4148 2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, & 4149 diffusivity, r_aero_surf , rb ) 4028 4150 ! 4029 4151 !-- Calculate budget 4030 4152 IF ( rc_tot <= 0.0 ) THEN 4031 bud_lup(lsp) = 0.0_wp 4153 4154 bud_luw(lsp) = 0.0_wp 4155 4032 4156 ELSE 4157 4033 4158 vd_lu = 1.0_wp / (r_aero_surf + rb + rc_tot ) 4034 bud_lup(lsp) = - (conc_ijk(lsp) - ccomp_tot(lsp)) * & 4035 (1.0_wp - exp(-vd_lu * dt_dh )) * dh 4159 4160 bud_luw(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) * & 4161 ( 1.0_wp - EXP(-vd_lu * dt_dh ) ) * dh 4036 4162 ENDIF 4037 4163 … … 4039 4165 ENDDO 4040 4166 ENDIF 4041 !4042 !-- Water4043 IF ( surf_lsm_h%frac(m,ind_wat_win) > 0 ) THEN4044 !4045 !-- No vegetation on water:4046 lai = 0.0_wp4047 sai = 0.0_wp4048 slinnfac = 1.0_wp4049 !4050 !-- Get vd4051 DO lsp = 1, nvar4052 !4053 !-- Initialize4054 vs = 0.0_wp4055 vd_lu = 0.0_wp4056 rs = 0.0_wp4057 rb = 0.0_wp4058 rc_tot = 0.0_wp4059 IF ( spc_names(lsp) == 'PM10' ) THEN4060 part_type = 14061 !4062 !-- Sedimentation velocity:4063 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), &4064 particle_pars(ind_p_size, part_type), &4065 particle_pars(ind_p_slip, part_type), &4066 visc)4067 4068 CALL drydepo_aero_zhang_vd( vd_lu, rs, &4069 vs, &4070 particle_pars(ind_p_size, part_type), &4071 particle_pars(ind_p_slip, part_type), &4072 nwet, temp_tmp, dens, visc, &4073 luw_dep, &4074 r_aero_surf, ustar_surf )4075 4076 bud_luw(lsp) = - conc_ijk(lsp) * &4077 (1.0_wp - exp(-vd_lu * dt_dh )) * dh4078 4079 ELSEIF ( spc_names(lsp) == 'PM25' ) THEN4080 part_type = 24081 !4082 !-- Sedimentation velocity:4083 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), &4084 particle_pars(ind_p_size, part_type), &4085 particle_pars(ind_p_slip, part_type), &4086 visc)4087 4088 CALL drydepo_aero_zhang_vd( vd_lu, rs, &4089 vs, &4090 particle_pars(ind_p_size, part_type), &4091 particle_pars(ind_p_slip, part_type), &4092 nwet, temp_tmp, dens, visc, &4093 luw_dep, &4094 r_aero_surf, ustar_surf )4095 4096 bud_luw(lsp) = - conc_ijk(lsp) * &4097 (1.0_wp - exp(-vd_lu * dt_dh )) * dh4098 4099 ELSE !<GASES4100 !4101 !-- Read spc_name of current species for gas PARAMETER4102 4103 IF ( ANY(pspecnames(:) == spc_names(lsp) ) ) THEN4104 i_pspec = 04105 DO pspec = 1, nposp4106 IF ( pspecnames(pspec) == spc_names(lsp) ) THEN4107 i_pspec = pspec4108 END IF4109 ENDDO4110 4111 ELSE4112 !4113 !-- For now species not deposited4114 CYCLE4115 ENDIF4116 !4117 !-- Factor used for conversion from ppb to ug/m3 :4118 !-- ppb (mole tr)/(mole air)/ppb (kg tr)/(mole tr) (ug tr)/(kg tr) &4119 !-- (mole air)/(kg air) (kg air)/(m3 air) (kg air(ug/m3)/ppb/(kg/mole) = / (kg/mole)4120 !-- c 1e-9 xm_tracer 1e9 / xm_air dens4121 !-- thus:4122 !-- c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm34123 !-- Use density at lowest layer:4124 4125 ppm2ugm3 = (dens/xm_air) * 0.001_wp !< (mole air)/m34126 !4127 !-- Atmospheric concentration in DEPAC is requested in ug/m3:4128 !-- ug/m3 ppm (ug/m3)/ppm/(kg/mole) kg/mole4129 conc_ijk_ugm3 = conc_ijk(lsp) * ppm2ugm3 * specmolm(i_pspec) ! in ug/m34130 !4131 !-- Diffusivity for DEPAC relevant gases4132 !-- Use default value4133 diffusivity = 0.11e-44134 !4135 !-- overwrite with known coefficients of diffusivity from Massman (1998)4136 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-44137 IF ( spc_names(lsp) == 'NO' ) diffusivity = 0.199e-44138 IF ( spc_names(lsp) == 'O3' ) diffusivity = 0.144e-44139 IF ( spc_names(lsp) == 'CO' ) diffusivity = 0.176e-44140 IF ( spc_names(lsp) == 'SO2' ) diffusivity = 0.112e-44141 IF ( spc_names(lsp) == 'CH4' ) diffusivity = 0.191e-44142 IF ( spc_names(lsp) == 'NH3' ) diffusivity = 0.191e-44143 !4144 !-- Get quasi-laminar boundary layer resistance rb:4145 CALL get_rb_cell( (luw_dep == ilu_water_sea) .OR. (luw_dep == ilu_water_inland), &4146 z0h_surf, ustar_surf, diffusivity, rb )4147 4148 !-- Get rc_tot4149 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, &4150 solar_rad, cos_zenith, rh_surf, lai, sai, nwet, luw_dep, 2, &4151 rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, diffusivity, &4152 r_aero_surf , rb )4153 !4154 !-- Calculate budget4155 IF ( rc_tot <= 0.0 ) THEN4156 4157 bud_luw(lsp) = 0.0_wp4158 4159 ELSE4160 4161 vd_lu = 1.0_wp / (r_aero_surf + rb + rc_tot )4162 4163 bud_luw(lsp) = - (conc_ijk(lsp) - ccomp_tot(lsp)) * &4164 (1.0_wp - exp(-vd_lu * dt_dh )) * dh4165 ENDIF4166 4167 ENDIF4168 ENDDO4169 ENDIF4170 4167 4171 4168 … … 4175 4172 DO lsp = 1, nspec 4176 4173 4177 bud(lsp) = surf_lsm_h%frac(m,ind_veg_wall) * bud_luv(lsp) +&4178 surf_lsm_h%frac(m,ind_pav_green) * bud_lup(lsp) +&4179 surf_lsm_h%frac(m,ind_wat_win)* bud_luw(lsp)4174 bud(lsp) = surf_lsm_h%frac(m,ind_veg_wall) * bud_luv(lsp) + & 4175 surf_lsm_h%frac(m,ind_pav_green) * bud_lup(lsp) + & 4176 surf_lsm_h%frac(m,ind_wat_win) * bud_luw(lsp) 4180 4177 ! 4181 4178 !-- Compute new concentration: 4182 4179 conc_ijk(lsp) = conc_ijk(lsp) + bud(lsp) * inv_dh 4183 4180 4184 chem_species(lsp)%conc(k,j,i) = MAX( 0.0_wp, conc_ijk(lsp))4181 chem_species(lsp)%conc(k,j,i) = MAX( 0.0_wp, conc_ijk(lsp) ) 4185 4182 4186 4183 ENDDO … … 4188 4185 ENDIF 4189 4186 ! 4190 !-- For USM surfaces 4191 4187 !-- For USM surfaces 4192 4188 IF ( match_usm ) THEN 4193 4189 ! … … 4225 4221 IF ( surf_usm_h%frac(m,ind_pav_green) > 0 ) THEN 4226 4222 ! 4227 !-- For green urban surfaces (e.g. green roofs 4228 !-- assume LU short grass 4223 !-- For green urban surfaces (e.g. green roofs assume LU short grass 4229 4224 lug_palm = ind_luv_s_grass 4230 4225 IF ( lug_palm == ind_luv_user ) THEN … … 4266 4261 lug_dep = 4 4267 4262 ELSEIF ( lug_palm == ind_luv_intrup_forest ) THEN 4268 lug_dep = 8 4263 lug_dep = 8 4269 4264 ENDIF 4270 4265 ENDIF … … 4273 4268 ! 4274 4269 !-- For walls in USM assume concrete walls/roofs, 4275 !-- assumed LU class desert as also assumed for 4276 !-- pavements in LSM 4270 !-- assumed LU class desert as also assumed for pavements in LSM 4277 4271 luu_palm = ind_lup_conc 4278 4272 IF ( luu_palm == ind_lup_user ) THEN … … 4290 4284 luu_dep = 9 4291 4285 ELSEIF ( luu_palm == ind_lup_cobblest ) THEN 4292 luu_dep = 9 4286 luu_dep = 9 4293 4287 ELSEIF ( luu_palm == ind_lup_metal ) THEN 4294 4288 luu_dep = 9 4295 4289 ELSEIF ( luu_palm == ind_lup_wood ) THEN 4296 luu_dep = 9 4290 luu_dep = 9 4297 4291 ELSEIF ( luu_palm == ind_lup_gravel ) THEN 4298 4292 luu_dep = 9 … … 4314 4308 IF ( surf_usm_h%frac(m,ind_wat_win) > 0 ) THEN 4315 4309 ! 4316 !-- For windows in USM assume metal as this is 4317 !-- as close as we get, assumed LU class desert 4318 !-- as also assumed for pavements in LSM 4319 lud_palm = ind_lup_metal 4310 !-- For windows in USM assume metal as this is as close as we get, assumed LU class desert as 4311 !-- also assumed for pavements in LSM. 4312 lud_palm = ind_lup_metal 4320 4313 IF ( lud_palm == ind_lup_user ) THEN 4321 4314 message_string = 'No pavement type defined. Please define pavement type to enable deposition calculation' … … 4332 4325 lud_dep = 9 4333 4326 ELSEIF ( lud_palm == ind_lup_cobblest ) THEN 4334 lud_dep = 9 4327 lud_dep = 9 4335 4328 ELSEIF ( lud_palm == ind_lup_metal ) THEN 4336 4329 lud_dep = 9 4337 4330 ELSEIF ( lud_palm == ind_lup_wood ) THEN 4338 lud_dep = 9 4331 lud_dep = 9 4339 4332 ELSEIF ( lud_palm == ind_lup_gravel ) THEN 4340 4333 lud_dep = 9 … … 4362 4355 !ENDIF 4363 4356 ! 4364 !-- Compute length of time step 4357 !-- Compute length of time step 4365 4358 IF ( call_chem_at_all_substeps ) THEN 4366 4359 dt_chem = dt_3d * weight_pres(intermediate_timestep_count) … … 4371 4364 dh = dzw(k) 4372 4365 inv_dh = 1.0_wp / dh 4373 dt_dh = dt_chem /dh4366 dt_dh = dt_chem / dh 4374 4367 ! 4375 4368 !-- Concentration at i,j,k … … 4384 4377 ! 4385 4378 !-- Viscosity of air 4386 visc = 1.496e-6 * temp_tmp**1.5 / ( temp_tmp + 120.0)4379 visc = 1.496e-6 * temp_tmp**1.5 / ( temp_tmp + 120.0 ) 4387 4380 ! 4388 4381 !-- Air density at k … … 4390 4383 ! 4391 4384 !-- Calculate relative humidity from specific humidity for DEPAC 4392 qv_tmp = MAX( q(k,j,i),0.0_wp)4393 rh_surf = relativehumidity_from_specifichumidity( qv_tmp, temp_tmp, hyp(k) )4394 ! 4395 !-- Check if surface fraction (vegetation, pavement or water) > 0 and calculate vd and budget 4396 !-- foreach surface fraction. Then derive overall budget taking into account the surface fractions.4397 ! 4385 qv_tmp = MAX( q(k,j,i), 0.0_wp ) 4386 rh_surf = relativehumidity_from_specifichumidity( qv_tmp, temp_tmp, hyp(k) ) 4387 ! 4388 !-- Check if surface fraction (vegetation, pavement or water) > 0 and calculate vd and budget for 4389 !-- each surface fraction. Then derive overall budget taking into account the surface fractions. 4390 4398 4391 !-- Walls/roofs 4399 4392 IF ( surf_usm_h%frac(m,ind_veg_wall) > 0 ) THEN … … 4408 4401 DO lsp = 1, nvar 4409 4402 ! 4410 !-- Initialize 4403 !-- Initialize 4411 4404 vs = 0.0_wp 4412 4405 vd_lu = 0.0_wp … … 4418 4411 ! 4419 4412 !-- Sedimentation velocity 4420 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4421 particle_pars(ind_p_size, part_type), & 4422 particle_pars(ind_p_slip, part_type), & 4423 visc) 4424 4425 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 4426 vs, & 4427 particle_pars(ind_p_size, part_type), & 4428 particle_pars(ind_p_slip, part_type), & 4429 nwet, temp_tmp, dens, visc, & 4430 luu_dep, & 4431 r_aero_surf, ustar_surf ) 4432 4433 bud_luu(lsp) = - conc_ijk(lsp) * & 4434 (1.0_wp - exp(-vd_lu * dt_dh )) * dh 4413 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4414 particle_pars(ind_p_size, part_type), & 4415 particle_pars(ind_p_slip, part_type), & 4416 visc) 4417 4418 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 4419 vs, & 4420 particle_pars(ind_p_size, part_type), & 4421 particle_pars(ind_p_slip, part_type), & 4422 nwet, temp_tmp, dens, visc, & 4423 luu_dep, & 4424 r_aero_surf, ustar_surf ) 4425 4426 bud_luu(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4435 4427 4436 4428 ELSEIF ( spc_names(lsp) == 'PM25' ) THEN … … 4438 4430 ! 4439 4431 !-- Sedimentation velocity 4440 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4441 particle_pars(ind_p_size, part_type), & 4442 particle_pars(ind_p_slip, part_type), & 4443 visc) 4444 4445 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 4446 vs, & 4447 particle_pars(ind_p_size, part_type), & 4448 particle_pars(ind_p_slip, part_type), & 4449 nwet, temp_tmp, dens, visc, & 4450 luu_dep , & 4451 r_aero_surf, ustar_surf ) 4452 4453 bud_luu(lsp) = - conc_ijk(lsp) * & 4454 (1.0_wp - exp(-vd_lu * dt_dh )) * dh 4432 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4433 particle_pars(ind_p_size, part_type), & 4434 particle_pars(ind_p_slip, part_type), & 4435 visc) 4436 4437 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 4438 vs, & 4439 particle_pars(ind_p_size, part_type), & 4440 particle_pars(ind_p_slip, part_type), & 4441 nwet, temp_tmp, dens, visc, & 4442 luu_dep , & 4443 r_aero_surf, ustar_surf ) 4444 4445 bud_luu(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4455 4446 4456 4447 ELSE !< GASES 4457 4448 ! 4458 4449 !-- Read spc_name of current species for gas parameter 4459 4460 4450 IF ( ANY( pspecnames(:) == spc_names(lsp) ) ) THEN 4461 4451 i_pspec = 0 … … 4478 4468 !-- c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm3 4479 4469 !-- Use density at k: 4480 4481 4470 ppm2ugm3 = (dens/xm_air) * 0.001_wp !< (mole air)/m3 4482 4471 … … 4487 4476 ! 4488 4477 !-- Diffusivity for DEPAC relevant gases 4489 !-- Use default value 4478 !-- Use default value 4490 4479 diffusivity = 0.11e-4 4491 4480 ! 4492 !-- overwrite with known coefficients of diffusivity from Massman (1998)4493 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4 4481 !-- Overwrite with known coefficients of diffusivity from Massman (1998) 4482 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4 4494 4483 IF ( spc_names(lsp) == 'NO' ) diffusivity = 0.199e-4 4495 4484 IF ( spc_names(lsp) == 'O3' ) diffusivity = 0.144e-4 … … 4500 4489 ! 4501 4490 !-- Get quasi-laminar boundary layer resistance rb: 4502 CALL get_rb_cell( ( luu_dep == ilu_water_sea) .OR. (luu_dep == ilu_water_inland),&4503 z0h_surf, ustar_surf, diffusivity,&4504 rb )4491 CALL get_rb_cell( ( luu_dep == ilu_water_sea ) .OR. & 4492 ( luu_dep == ilu_water_inland ), z0h_surf, ustar_surf, & 4493 diffusivity, rb ) 4505 4494 ! 4506 4495 !-- Get rc_tot 4507 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, 4508 solar_rad, cos_zenith, rh_surf, lai, sai, nwet, luu_dep, 2,&4509 rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, diffusivity,&4510 r_aero_surf, rb )4496 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, & 4497 solar_rad, cos_zenith, rh_surf, lai, sai, nwet, luu_dep, & 4498 2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, & 4499 diffusivity, r_aero_surf, rb ) 4511 4500 ! 4512 4501 !-- Calculate budget … … 4519 4508 vd_lu = 1.0_wp / (r_aero_surf + rb + rc_tot ) 4520 4509 4521 bud_luu(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp)) *&4522 (1.0_wp - exp(-vd_lu * dt_dh )) * dh4510 bud_luu(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) * & 4511 ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4523 4512 ENDIF 4524 4513 … … 4532 4521 ! 4533 4522 !-- No vegetation on bare soil, desert or ice: 4534 IF ( ( lug_palm == ind_luv_b_soil ) .OR. & 4535 ( lug_palm == ind_luv_desert ) .OR. & 4536 ( lug_palm == ind_luv_ice ) ) THEN 4523 IF ( ( lug_palm == ind_luv_b_soil ) .OR. ( lug_palm == ind_luv_desert ) .OR. & 4524 ( lug_palm == ind_luv_ice ) ) THEN 4537 4525 4538 4526 lai = 0.0_wp … … 4541 4529 ENDIF 4542 4530 4543 4531 4544 4532 slinnfac = 1.0_wp 4545 4533 ! … … 4557 4545 ! 4558 4546 !-- Sedimentation velocity 4559 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4560 particle_pars(ind_p_size, part_type), & 4561 particle_pars(ind_p_slip, part_type), & 4562 visc) 4563 4564 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 4565 vs, & 4566 particle_pars(ind_p_size, part_type), & 4567 particle_pars(ind_p_slip, part_type), & 4568 nwet, temp_tmp, dens, visc, & 4569 lug_dep, & 4570 r_aero_surf, ustar_surf ) 4571 4572 bud_lug(lsp) = - conc_ijk(lsp) * & 4573 (1.0_wp - exp(-vd_lu * dt_dh )) * dh 4547 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4548 particle_pars(ind_p_size, part_type), & 4549 particle_pars(ind_p_slip, part_type), & 4550 visc) 4551 4552 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 4553 vs, & 4554 particle_pars(ind_p_size, part_type), & 4555 particle_pars(ind_p_slip, part_type), & 4556 nwet, temp_tmp, dens, visc, & 4557 lug_dep, & 4558 r_aero_surf, ustar_surf ) 4559 4560 bud_lug(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4574 4561 4575 4562 ELSEIF ( spc_names(lsp) == 'PM25' ) THEN … … 4577 4564 ! 4578 4565 !-- Sedimentation velocity 4579 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4580 particle_pars(ind_p_size, part_type), & 4581 particle_pars(ind_p_slip, part_type), & 4582 visc) 4583 4584 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 4585 vs, & 4586 particle_pars(ind_p_size, part_type), & 4587 particle_pars(ind_p_slip, part_type), & 4588 nwet, temp_tmp, dens, visc, & 4589 lug_dep, & 4590 r_aero_surf, ustar_surf ) 4591 4592 bud_lug(lsp) = - conc_ijk(lsp) * & 4593 (1.0_wp - exp(-vd_lu * dt_dh )) * dh 4566 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4567 particle_pars(ind_p_size, part_type), & 4568 particle_pars(ind_p_slip, part_type), & 4569 visc) 4570 4571 CALL drydepo_aero_zhang_vd( vd_lu, rs, & 4572 vs, & 4573 particle_pars(ind_p_size, part_type), & 4574 particle_pars(ind_p_slip, part_type), & 4575 nwet, temp_tmp, dens, visc, & 4576 lug_dep, & 4577 r_aero_surf, ustar_surf ) 4578 4579 bud_lug(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4594 4580 4595 4581 ELSE !< GASES 4596 4582 ! 4597 4583 !-- Read spc_name of current species for gas parameter 4598 4599 4584 IF ( ANY( pspecnames(:) == spc_names(lsp) ) ) THEN 4600 4585 i_pspec = 0 … … 4617 4602 !-- c_in_ppb * xm_tracer * [ dens / xm_air ] = c_in_ugm3 4618 4603 !-- Use density at k: 4619 4620 4604 ppm2ugm3 = (dens/xm_air) * 0.001_wp ! (mole air)/m3 4621 4605 ! … … 4625 4609 ! 4626 4610 !-- Diffusivity for DEPAC relevant gases 4627 !-- Use default value 4611 !-- Use default value 4628 4612 diffusivity = 0.11e-4 4629 4613 ! 4630 !-- overwrite with known coefficients of diffusivity from Massman (1998)4631 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4 4614 !-- Overwrite with known coefficients of diffusivity from Massman (1998) 4615 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4 4632 4616 IF ( spc_names(lsp) == 'NO' ) diffusivity = 0.199e-4 4633 4617 IF ( spc_names(lsp) == 'O3' ) diffusivity = 0.144e-4 … … 4638 4622 ! 4639 4623 !-- Get quasi-laminar boundary layer resistance rb: 4640 CALL get_rb_cell( ( lug_dep == ilu_water_sea) .OR. (lug_dep == ilu_water_inland),&4641 z0h_surf, ustar_surf, diffusivity,&4642 rb )4624 CALL get_rb_cell( ( lug_dep == ilu_water_sea ) .OR. & 4625 ( lug_dep == ilu_water_inland ), z0h_surf, ustar_surf, & 4626 diffusivity, rb ) 4643 4627 ! 4644 4628 !-- Get rc_tot 4645 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, 4646 solar_rad, cos_zenith, rh_surf, lai, sai, nwet, lug_dep, 2,&4647 rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, diffusivity,&4648 r_aero_surf , rb )4629 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, & 4630 solar_rad, cos_zenith, rh_surf, lai, sai, nwet, lug_dep, & 4631 2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, & 4632 diffusivity, r_aero_surf , rb ) 4649 4633 ! 4650 4634 !-- Calculate budget … … 4655 4639 ELSE 4656 4640 4657 vd_lu = 1.0_wp / ( r_aero_surf + rb + rc_tot )4658 4659 bud_lug(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp)) *&4660 (1.0_wp - exp(-vd_lu * dt_dh ))* dh4641 vd_lu = 1.0_wp / ( r_aero_surf + rb + rc_tot ) 4642 4643 bud_lug(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) * & 4644 ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4661 4645 ENDIF 4662 4646 … … 4682 4666 rs = 0.0_wp 4683 4667 rb = 0.0_wp 4684 rc_tot = 0.0_wp 4668 rc_tot = 0.0_wp 4685 4669 IF ( spc_names(lsp) == 'PM10' ) THEN 4686 4670 part_type = 1 4687 4671 ! 4688 4672 !-- Sedimentation velocity 4689 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4690 particle_pars(ind_p_size, part_type), & 4691 particle_pars(ind_p_slip, part_type), & 4692 visc) 4693 4694 CALL drydepo_aero_zhang_vd( vd_lu, rs, vs, & 4695 particle_pars(ind_p_size, part_type), & 4696 particle_pars(ind_p_slip, part_type), & 4697 nwet, temp_tmp, dens, visc, & 4698 lud_dep, r_aero_surf, ustar_surf ) 4699 4700 bud_lud(lsp) = - conc_ijk(lsp) * & 4701 (1.0_wp - exp(-vd_lu * dt_dh )) * dh 4673 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4674 particle_pars(ind_p_size, part_type), & 4675 particle_pars(ind_p_slip, part_type), & 4676 visc) 4677 4678 CALL drydepo_aero_zhang_vd( vd_lu, rs, vs, & 4679 particle_pars(ind_p_size, part_type), & 4680 particle_pars(ind_p_slip, part_type), & 4681 nwet, temp_tmp, dens, visc, & 4682 lud_dep, r_aero_surf, ustar_surf ) 4683 4684 bud_lud(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4702 4685 4703 4686 ELSEIF ( spc_names(lsp) == 'PM25' ) THEN … … 4705 4688 ! 4706 4689 !-- Sedimentation velocity 4707 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4708 particle_pars(ind_p_size, part_type), & 4709 particle_pars(ind_p_slip, part_type), & 4710 visc) 4711 4712 CALL drydepo_aero_zhang_vd( vd_lu, rs, vs, & 4713 particle_pars(ind_p_size, part_type), & 4714 particle_pars(ind_p_slip, part_type), & 4715 nwet, temp_tmp, dens, visc, & 4716 lud_dep, & 4717 r_aero_surf, ustar_surf ) 4718 4719 bud_lud(lsp) = - conc_ijk(lsp) * & 4720 (1.0_wp - exp(-vd_lu * dt_dh )) * dh 4690 vs = slinnfac * sedimentation_velocity( particle_pars(ind_p_dens, part_type), & 4691 particle_pars(ind_p_size, part_type), & 4692 particle_pars(ind_p_slip, part_type), & 4693 visc) 4694 4695 CALL drydepo_aero_zhang_vd( vd_lu, rs, vs, & 4696 particle_pars(ind_p_size, part_type), & 4697 particle_pars(ind_p_slip, part_type), & 4698 nwet, temp_tmp, dens, visc, & 4699 lud_dep, & 4700 r_aero_surf, ustar_surf ) 4701 4702 bud_lud(lsp) = - conc_ijk(lsp) * ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4721 4703 4722 4704 ELSE !< GASES 4723 4705 ! 4724 4706 !-- Read spc_name of current species for gas PARAMETER 4725 4726 4707 IF ( ANY( pspecnames(:) == spc_names(lsp) ) ) THEN 4727 4708 i_pspec = 0 … … 4752 4733 ! 4753 4734 !-- Diffusivity for DEPAC relevant gases 4754 !-- Use default value 4735 !-- Use default value 4755 4736 diffusivity = 0.11e-4 4756 4737 ! 4757 !-- overwrite with known coefficients of diffusivity from Massman (1998)4758 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4 4738 !-- Overwrite with known coefficients of diffusivity from Massman (1998) 4739 IF ( spc_names(lsp) == 'NO2' ) diffusivity = 0.136e-4 4759 4740 IF ( spc_names(lsp) == 'NO' ) diffusivity = 0.199e-4 4760 4741 IF ( spc_names(lsp) == 'O3' ) diffusivity = 0.144e-4 … … 4765 4746 ! 4766 4747 !-- Get quasi-laminar boundary layer resistance rb: 4767 CALL get_rb_cell( (lud_dep == ilu_water_sea) .OR. (lud_dep == ilu_water_inland), & 4768 z0h_surf, ustar_surf, diffusivity, rb ) 4748 CALL get_rb_cell( ( lud_dep == ilu_water_sea ) .OR. & 4749 ( lud_dep == ilu_water_inland ), z0h_surf, ustar_surf, & 4750 diffusivity, rb ) 4769 4751 ! 4770 4752 !-- Get rc_tot 4771 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, 4772 solar_rad, cos_zenith, rh_surf, lai, sai, nwet, lud_dep, 2,&4773 rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, diffusivity,&4774 r_aero_surf , rb )4775 ! 4776 !-- Calculate budget 4753 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, & 4754 solar_rad, cos_zenith, rh_surf, lai, sai, nwet, lud_dep, & 4755 2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, & 4756 diffusivity, r_aero_surf , rb ) 4757 ! 4758 !-- Calculate budget 4777 4759 IF ( rc_tot <= 0.0 ) THEN 4778 4760 … … 4783 4765 vd_lu = 1.0_wp / (r_aero_surf + rb + rc_tot ) 4784 4766 4785 bud_lud(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp)) *&4786 (1.0_wp - exp(-vd_lu * dt_dh ))* dh4767 bud_lud(lsp) = - ( conc_ijk(lsp) - ccomp_tot(lsp) ) * & 4768 ( 1.0_wp - EXP( - vd_lu * dt_dh ) ) * dh 4787 4769 ENDIF 4788 4770 … … 4798 4780 4799 4781 4800 bud(lsp) = surf_usm_h%frac(m,ind_veg_wall) * bud_luu(lsp) +&4801 surf_usm_h%frac(m,ind_pav_green) * bud_lug(lsp) +&4802 surf_usm_h%frac(m,ind_wat_win)* bud_lud(lsp)4782 bud(lsp) = surf_usm_h%frac(m,ind_veg_wall) * bud_luu(lsp) + & 4783 surf_usm_h%frac(m,ind_pav_green) * bud_lug(lsp) + & 4784 surf_usm_h%frac(m,ind_wat_win) * bud_lud(lsp) 4803 4785 ! 4804 4786 !-- Compute new concentration … … 4815 4797 4816 4798 4817 !------------------------------------------------------------------------------ !4799 !--------------------------------------------------------------------------------------------------! 4818 4800 ! Description: 4819 4801 ! ------------ … … 4821 4803 !> 4822 4804 !> DEPAC: 4823 !> Code of the DEPAC routine and corresponding subroutines below from the DEPAC 4824 !> module of theLOTOS-EUROS model (Manders et al., 2017)4805 !> Code of the DEPAC routine and corresponding subroutines below from the DEPAC module of the 4806 !> LOTOS-EUROS model (Manders et al., 2017) 4825 4807 !> 4826 !> Original DEPAC routines by RIVM and TNO (2015), for Documentation see 4827 !> van Zanten et al., 2010. 4828 !------------------------------------------------------------------------------! 4829 SUBROUTINE drydepos_gas_depac( compnam, day_of_year, lat, t, ust, solar_rad, sinphi, & 4830 rh, lai, sai, nwet, lu, iratns, rc_tot, ccomp_tot, p, conc_ijk_ugm3, diffusivity, & 4831 ra, rb ) 4808 !> Original DEPAC routines by RIVM and TNO (2015), for Documentation see van Zanten et al., 2010. 4809 !--------------------------------------------------------------------------------------------------! 4810 SUBROUTINE drydepos_gas_depac( compnam, day_of_year, lat, t, ust, solar_rad, sinphi, rh, lai, sai,& 4811 nwet, lu, iratns, rc_tot, ccomp_tot, p, conc_ijk_ugm3, diffusivity,& 4812 ra, rb ) 4832 4813 ! 4833 4814 !-- Some of depac arguments are OPTIONAL: 4834 4815 !-- A. compute Rc_tot without compensation points (ccomp_tot will be zero): 4835 !-- CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot, ccomp_tot, [smi]) 4816 !-- CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot,& 4817 !-- ccomp_tot, [smi]) 4836 4818 !-- B. compute Rc_tot with compensation points (used for LOTOS-EUROS): 4837 !-- CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot, ccomp_tot, [smi],&4838 !-- c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water)4819 !-- CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot,& 4820 !-- ccomp_tot, [smi], c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water) 4839 4821 !-- 4840 4822 !-- C. compute effective Rc based on compensation points (used for OPS): 4841 !-- CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot, ccomp_tot, [smi], & 4842 !-- c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water, & 4843 !-- ra, rb, rc_eff) 4844 !-- X1. Extra (OPTIONAL) output variables: 4845 !-- CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot, ccomp_tot, [smi], & 4846 !-- c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water, & 4847 !-- ra, rb, rc_eff, & 4848 !-- gw_out, gstom_out, gsoil_eff_out, cw_out, cstom_out, csoil_out, lai_out, sai_out) 4849 !-- X2. Extra (OPTIONAL) needed for stomatal ozone flux calculation (only sunlit leaves): 4850 !-- CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot, ccomp_tot, [smi], & 4851 !-- c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water, & 4852 !-- ra, rb, rc_eff, & 4853 !-- gw_out, gstom_out, gsoil_eff_out, cw_out, cstom_out, csoil_out, lai_out, sai_out, & 4854 !-- calc_stom_o3flux, frac_sto_o3_lu, fac_surface_area_2_PLA) 4823 !-- CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot,& 4824 !-- ccomp_tot, [smi], c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water, ra, & 4825 !-- rb, rc_eff) 4826 !-- X1. Extra (OPTIONAL) output variables: 4827 !-- CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot,& 4828 !-- ccomp_tot, [smi], c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water, ra, & 4829 !-- rb, rc_eff, gw_out, gstom_out, gsoil_eff_out, cw_out, cstom_out, csoil_out, & 4830 !-- lai_out, sai_out) 4831 !-- X2. Extra (OPTIONAL) needed for stomatal ozone flux calculation (only sunlit leaves): 4832 !-- CALL depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot,& 4833 !-- ccomp_tot, [smi], c_ave_prev_nh3, c_ave_prev_so2, catm, gamma_soil_water, ra, & 4834 !-- rb, rc_eff, gw_out, gstom_out, gsoil_eff_out, cw_out, cstom_out, csoil_out, & 4835 !-- lai_out, sai_out, calc_stom_o3flux, frac_sto_o3_lu, fac_surface_area_2_PLA) 4855 4836 4856 4837 … … 4858 4839 !< 'HNO3','NO','NO2','O3','SO2','NH3' 4859 4840 INTEGER(iwp), INTENT(IN) :: day_of_year !< day of year, 1 ... 365 (366) 4860 INTEGER(iwp), INTENT(IN) :: nwet !< wetness indicator; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow4861 INTEGER(iwp), INTENT(IN) :: lu !< land use type, lu = 1,...,nlu4862 4841 INTEGER(iwp), INTENT(IN) :: iratns !< index for NH3/SO2 ratio used for SO2: 4863 4842 !< iratns = 1: low NH3/SO2 4864 4843 !< iratns = 2: high NH3/SO2 4865 4844 !< iratns = 3: very low NH3/SO2 4866 REAL(wp), INTENT(IN) :: lat !< latitude Northern hemisphere (degrees) (S. hemisphere not possible) 4845 INTEGER(iwp), INTENT(IN) :: lu !< land use type, lu = 1,...,nlu 4846 INTEGER(iwp), INTENT(IN) :: nwet !< wetness indicator; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow 4847 4848 REAL(wp), INTENT(IN) :: conc_ijk_ugm3 !< actual atmospheric concentration (ug/m3), in 4849 !< DEPAC=Catm 4850 REAL(wp), INTENT(IN) :: diffusivity !< diffusivity 4851 REAL(wp), INTENT(IN) :: lai !< one-sidedleaf area index (-) 4852 REAL(wp), INTENT(IN) :: lat !< latitude Northern hemisphere (degrees) (S. 4853 !< hemisphere not possible) 4854 REAL(wp), INTENT(IN) :: p !< pressure (Pa) 4855 REAL(wp), INTENT(IN) :: ra !< aerodynamic resistance (s/m) 4856 REAL(wp), INTENT(IN) :: rb !< boundary layer resistance (s/m) 4857 REAL(wp), INTENT(IN) :: rh !< relative humidity (%) 4858 REAL(wp), INTENT(IN) :: sai !< surface area index (-) (lai + branches and 4859 !< stems) 4860 REAL(wp), INTENT(IN) :: sinphi !< sin of solar elevation angle 4861 REAL(wp), INTENT(IN) :: solar_rad !< solar radiation, dirict+diffuse (W/m2) 4867 4862 REAL(wp), INTENT(IN) :: t !< temperature (C) 4868 4863 REAL(wp), INTENT(IN) :: ust !< friction velocity (m/s) 4869 REAL(wp), INTENT(IN) :: solar_rad !< solar radiation, dirict+diffuse (W/m2) 4870 REAL(wp), INTENT(IN) :: sinphi !< sin of solar elevation angle 4871 REAL(wp), INTENT(IN) :: rh !< relative humidity (%) 4872 REAL(wp), INTENT(IN) :: lai !< one-sidedleaf area index (-) 4873 REAL(wp), INTENT(IN) :: sai !< surface area index (-) (lai + branches and stems) 4874 REAL(wp), INTENT(IN) :: diffusivity !< diffusivity 4875 REAL(wp), INTENT(IN) :: p !< pressure (Pa) 4876 REAL(wp), INTENT(IN) :: conc_ijk_ugm3 !< actual atmospheric concentration (ug/m3), in DEPAC=Catm 4877 REAL(wp), INTENT(IN) :: ra !< aerodynamic resistance (s/m) 4878 REAL(wp), INTENT(IN) :: rb !< boundary layer resistance (s/m) 4879 4864 4865 REAL(wp), INTENT(OUT) :: ccomp_tot !< total compensation point (ug/m3) 4866 ! !< [= 0 for species that don't have a compensation 4880 4867 REAL(wp), INTENT(OUT) :: rc_tot !< total canopy resistance Rc (s/m) 4881 REAL(wp), INTENT(OUT) :: ccomp_tot !< total compensation point (ug/m3) 4882 ! !< [= 0 for species that don't have a compensation 4868 4883 4869 !-- Local variables: 4884 4870 ! … … 4899 4885 4900 4886 LOGICAL :: ready !< Rc has been set: 4901 !< = 1 -> constant Rc4902 !< = 2 -> temperature dependent Rc4887 !< = 1 -> constant Rc 4888 !< = 2 -> temperature dependent Rc 4903 4889 ! 4904 4890 !-- Vegetation indicators: 4905 4891 LOGICAL :: lai_present !< leaves are present for current land use type 4906 LOGICAL :: sai_present !< vegetation is present for current land use type 4907 4892 LOGICAL :: sai_present !< vegetation is present for current land use 4893 !< type 4894 4895 REAL(wp) :: csoil !< soil compensation point (ug/m3) 4896 REAL(wp) :: cstom !< stomatal compensation point (ug/m3) 4897 REAL(wp) :: cw !< external leaf surface compensation point 4898 !< (ug/m3) 4899 REAL(wp) :: gc_tot !< total canopy conductance (m/s) 4900 REAL(wp) :: gsoil_eff !< effective soil conductance (m/s) 4901 REAL(wp) :: gstom !< stomatal conductance (m/s) 4902 REAL(wp) :: gw !< external leaf conductance (m/s) 4908 4903 ! REAL(wp) :: laimax !< maximum leaf area index (-) 4909 REAL(wp) :: gw !< external leaf conductance (m/s)4910 REAL(wp) :: gstom !< stomatal conductance (m/s)4911 REAL(wp) :: gsoil_eff !< effective soil conductance (m/s)4912 REAL(wp) :: gc_tot !< total canopy conductance (m/s)4913 REAL(wp) :: cw !< external leaf surface compensation point (ug/m3)4914 REAL(wp) :: cstom !< stomatal compensation point (ug/m3)4915 REAL(wp) :: csoil !< soil compensation point (ug/m3)4916 4904 ! 4917 4905 !-- Next statement is just to avoid compiler warning about unused variable … … 4931 4919 4932 4920 CASE ( 'NO', 'no' ) 4933 icmp = icmp_no 4921 icmp = icmp_no 4934 4922 4935 4923 CASE ( 'NH3', 'nh3' ) … … 4979 4967 ! 4980 4968 !-- External conductance: 4981 CALL rc_gw( compnam, iratns, t, rh, nwet, sai_present, sai,gw ) 4969 CALL rc_gw( compnam, iratns, t, rh, nwet, sai_present, sai,gw ) 4982 4970 ! 4983 4971 !-- Stomatal conductance: 4984 CALL rc_gstom( icmp, compnam, lu, lai_present, lai, solar_rad, sinphi, t, rh, diffusivity, gstom, p ) 4972 CALL rc_gstom( icmp, compnam, lu, lai_present, lai, solar_rad, sinphi, t, rh, diffusivity, & 4973 gstom, p ) 4985 4974 ! 4986 4975 !-- Effective soil conductance: … … 5000 4989 ! 5001 4990 !-- Effective Rc based on compensation points: 5002 !-- IF ( present(rc_eff) ) then4991 !-- IF ( PRESENT( rc_eff ) ) THEN 5003 4992 !-- check on required arguments: 5004 !-- IF ( (.not. present(conc_ijk_ugm3)) .OR. (.not. present(ra)) .OR. (.not. present(rb)) ) then 5005 !-- stop 'output argument rc_eff requires input arguments conc_ijk_ugm3, ra and rb' 5006 !-- END IF 5007 ! 5008 !-- Compute rc_eff : 5009 ! CALL rc_comp_point_rc_eff(ccomp_tot,conc_ijk_ugm3,ra,rb,rc_tot,rc_eff) 5010 ! ENDIF 4993 !-- IF ( ( .NOT. PRESENT( conc_ijk_ugm3 ) ) .OR. ( .NOT. PRESENT( ra ) ) .OR. & 4994 !-- ( .NOT. PRESENT( rb ) ) ) THEN 4995 !-- STOP 'output argument rc_eff requires input arguments conc_ijk_ugm3, ra and rb' 4996 !-- ENDIF 4997 ! 4998 !-- Compute rc_eff : 4999 !-- CALL rc_comp_point_rc_eff(ccomp_tot,conc_ijk_ugm3,ra,rb,rc_tot,rc_eff) 5000 !-- ENDIF 5011 5001 ENDIF 5012 5002 … … 5014 5004 5015 5005 5016 !------------------------------------------------------------------------------ !5006 !--------------------------------------------------------------------------------------------------! 5017 5007 ! Description: 5018 5008 ! ------------ 5019 5009 !> Subroutine to compute total canopy resistance in special cases 5020 !------------------------------------------------------------------------------ !5010 !--------------------------------------------------------------------------------------------------! 5021 5011 SUBROUTINE rc_special( icmp, compnam, lu, t, nwet, rc_tot, ready, ccomp_tot ) 5022 5012 5023 5013 5024 5014 CHARACTER(LEN=*), INTENT(IN) :: compnam !< component name 5025 5015 5026 INTEGER(iwp), INTENT(IN) :: icmp !< component index 5016 INTEGER(iwp), INTENT(IN) :: icmp !< component index 5027 5017 INTEGER(iwp), INTENT(IN) :: lu !< land use type, lu = 1,...,nlu 5028 5018 INTEGER(iwp), INTENT(IN) :: nwet !< wetness indicator; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow 5029 5019 5030 REAL(wp), INTENT(IN) :: t !< temperature (C)5031 5032 REAL(wp), INTENT(OUT) :: rc_tot !< total canopy resistance Rc (s/m)5033 REAL(wp), INTENT(OUT) :: ccomp_tot !< total compensation point (ug/m3)5034 5035 5020 LOGICAL, INTENT(OUT) :: ready !< Rc has been set 5036 5021 !< = 1 -> constant Rc 5022 5023 REAL(wp), INTENT(IN) :: t !< temperature (C) 5024 5025 REAL(wp), INTENT(OUT) :: ccomp_tot !< total compensation point (ug/m3) 5026 REAL(wp), INTENT(OUT) :: rc_tot !< total canopy resistance Rc (s/m) 5027 5037 5028 ! 5038 5029 !-- Next line is to avoid compiler warning about unused variable … … 5055 5046 ELSE 5056 5047 ! 5057 !-- all other circumstances:5048 !-- All other circumstances: 5058 5049 rc_tot = 10.0_wp 5059 5050 ENDIF … … 5085 5076 5086 5077 5087 !------------------------------------------------------------------------------ !5078 !--------------------------------------------------------------------------------------------------! 5088 5079 ! Description: 5089 5080 ! ------------ 5090 5081 !> Subroutine to compute external conductance 5091 !------------------------------------------------------------------------------ !5082 !--------------------------------------------------------------------------------------------------! 5092 5083 SUBROUTINE rc_gw( compnam, iratns, t, rh, nwet, sai_present, sai, gw ) 5093 5084 … … 5095 5086 !-- Input/output variables: 5096 5087 CHARACTER(LEN=*), INTENT(IN) :: compnam !< component name 5097 5098 INTEGER(iwp), INTENT(IN) :: nwet !< wetness indicator; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow5099 5088 INTEGER(iwp), INTENT(IN) :: iratns !< index for NH3/SO2 ratio; 5100 5089 !< iratns = 1: low NH3/SO2 5101 5090 !< iratns = 2: high NH3/SO2 5102 5091 !< iratns = 3: very low NH3/SO2 5092 5093 INTEGER(iwp), INTENT(IN) :: nwet !< wetness indicator; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow 5094 5103 5095 LOGICAL, INTENT(IN) :: sai_present 5104 5096 5105 REAL(wp), INTENT(IN) :: t !< temperature (C)5106 5097 REAL(wp), INTENT(IN) :: rh !< relative humidity (%) 5107 5098 REAL(wp), INTENT(IN) :: sai !< one-sided leaf area index (-) 5099 REAL(wp), INTENT(IN) :: t !< temperature (C) 5108 5100 5109 5101 REAL(wp), INTENT(OUT) :: gw !< external leaf conductance (m/s) … … 5126 5118 CALL rw_nh3_sutton( t, rh, sai_present, gw ) 5127 5119 ! 5128 !-- conversion from leaf resistance to canopy resistance by multiplying with sai:5120 !-- Conversion from leaf resistance to canopy resistance by multiplying with sai: 5129 5121 gw = sai * gw 5130 5122 … … 5137 5129 5138 5130 5139 !------------------------------------------------------------------------------ !5131 !--------------------------------------------------------------------------------------------------! 5140 5132 ! Description: 5141 5133 ! ------------ 5142 5134 !> Subroutine to compute external leaf conductance for SO2 5143 !------------------------------------------------------------------------------ !5135 !--------------------------------------------------------------------------------------------------! 5144 5136 SUBROUTINE rw_so2( t, nwet, rh, iratns, sai_present, gw ) 5145 5137 5146 5138 ! 5147 5139 !-- Input/output variables: 5148 INTEGER(iwp), INTENT(IN) :: nwet !< wetness indicator; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow5149 5140 INTEGER(iwp), INTENT(IN) :: iratns !< index for NH3/SO2 ratio: 5150 5141 !< iratns = 1: low NH3/SO2 5151 5142 !< iratns = 2: high NH3/SO2 5152 5143 !< iratns = 3: very low NH3/SO2 5144 INTEGER(iwp), INTENT(IN) :: nwet !< wetness indicator; nwet=0 -> dry; nwet=1 -> wet; nwet=9 -> snow 5145 5153 5146 LOGICAL, INTENT(IN) :: sai_present 5154 5147 5148 REAL(wp), INTENT(IN) :: rh !< relative humidity (%) 5155 5149 REAL(wp), INTENT(IN) :: t !< temperature (C) 5156 REAL(wp), INTENT(IN) :: rh !< relative humidity (%)5157 5150 5158 5151 REAL(wp), INTENT(OUT) :: gw !< external leaf conductance (m/s) … … 5172 5165 IF ( t > -1.0_wp ) THEN 5173 5166 IF ( rh < 81.3_wp ) THEN 5174 rw = 25000.0_wp * exp( -0.0693_wp * rh )5167 rw = 25000.0_wp * EXP( -0.0693_wp * rh ) 5175 5168 ELSE 5176 rw = 0.58e12 * exp( -0.278_wp * rh ) + 10.0_wp5169 rw = 0.58e12 * EXP( -0.278_wp * rh ) + 10.0_wp 5177 5170 ENDIF 5178 5171 ELSE … … 5193 5186 ENDIF 5194 5187 ! 5195 !-- very low NH3/SO2 ratio:5188 !-- Very low NH3/SO2 ratio: 5196 5189 IF ( iratns == iratns_very_low ) rw = rw + 50.0_wp 5197 5190 ! … … 5200 5193 ELSE 5201 5194 ! 5202 !-- no vegetation:5195 !-- No vegetation: 5203 5196 gw = 0.0_wp 5204 5197 ENDIF … … 5207 5200 5208 5201 5209 !------------------------------------------------------------------------------ !5202 !--------------------------------------------------------------------------------------------------! 5210 5203 ! Description: 5211 5204 ! ------------ 5212 !> Subroutine to compute external leaf conductance for NH3, 5213 !> following Sutton & Fowler, 1993 5214 !------------------------------------------------------------------------------! 5205 !> Subroutine to compute external leaf conductance for NH3, following Sutton & Fowler, 1993 5206 !--------------------------------------------------------------------------------------------------! 5215 5207 SUBROUTINE rw_nh3_sutton( tsurf, rh,sai_present, gw ) 5216 5208 … … 5219 5211 LOGICAL, INTENT(IN) :: sai_present 5220 5212 5213 REAL(wp), INTENT(IN) :: rh !< relative humidity (%) 5221 5214 REAL(wp), INTENT(IN) :: tsurf !< surface temperature (C) 5222 REAL(wp), INTENT(IN) :: rh !< relative humidity (%)5223 5215 5224 5216 REAL(wp), INTENT(OUT) :: gw !< external leaf conductance (m/s) … … 5239 5231 ! 5240 5232 !-- External resistance according to Sutton & Fowler, 1993 5241 rw = 2.0_wp * exp( ( 100.0_wp - rh ) / 12.0_wp )5233 rw = 2.0_wp * EXP( ( 100.0_wp - rh ) / 12.0_wp ) 5242 5234 rw = sai_grass_haarweg * rw 5243 5235 ! … … 5255 5247 5256 5248 5257 !------------------------------------------------------------------------------ !5249 !--------------------------------------------------------------------------------------------------! 5258 5250 ! Description: 5259 5251 ! ------------ 5260 !> Subroutine to compute external leaf conductance 5261 !------------------------------------------------------------------------------ !5252 !> Subroutine to compute external leaf conductance 5253 !--------------------------------------------------------------------------------------------------! 5262 5254 SUBROUTINE rw_constant( rw_val, sai_present, gw ) 5263 5255 … … 5266 5258 LOGICAL, INTENT(IN) :: sai_present 5267 5259 5268 REAL(wp), INTENT(IN) :: rw_val !< constant value of Rw 5260 REAL(wp), INTENT(IN) :: rw_val !< constant value of Rw 5269 5261 5270 5262 REAL(wp), INTENT(OUT) :: gw !< wernal leaf conductance (m/s) 5271 5263 ! 5272 5264 !-- Compute conductance: 5273 IF ( sai_present .AND. .NOT.missing(rw_val) ) THEN5265 IF ( sai_present .AND. .NOT. missing(rw_val) ) THEN 5274 5266 gw = 1.0_wp / rw_val 5275 5267 ELSE … … 5280 5272 5281 5273 5282 !------------------------------------------------------------------------------ !5274 !--------------------------------------------------------------------------------------------------! 5283 5275 ! Description: 5284 5276 ! ------------ 5285 !> Subroutine to compute stomatal conductance 5286 !------------------------------------------------------------------------------! 5287 SUBROUTINE rc_gstom( icmp, compnam, lu, lai_present, lai, solar_rad, sinphi, t, rh, diffusivity, gstom, p ) 5277 !> Subroutine to compute stomatal conductance 5278 !--------------------------------------------------------------------------------------------------! 5279 SUBROUTINE rc_gstom( icmp, compnam, lu, lai_present, lai, solar_rad, sinphi, t, rh, diffusivity, & 5280 gstom, p ) 5288 5281 5289 5282 ! … … 5296 5289 LOGICAL, INTENT(IN) :: lai_present 5297 5290 5291 REAL(wp), INTENT(IN) :: diffusivity !< diffusion coefficient of the gas involved 5298 5292 REAL(wp), INTENT(IN) :: lai !< one-sided leaf area index 5293 REAL(wp), INTENT(IN) :: rh !< relative humidity (%) 5294 REAL(wp), INTENT(IN) :: sinphi !< sin of solar elevation angle 5299 5295 REAL(wp), INTENT(IN) :: solar_rad !< solar radiation, dirict+diffuse (W/m2) 5300 REAL(wp), INTENT(IN) :: sinphi !< sin of solar elevation angle5301 5296 REAL(wp), INTENT(IN) :: t !< temperature (C) 5302 REAL(wp), INTENT(IN) :: rh !< relative humidity (%)5303 REAL(wp), INTENT(IN) :: diffusivity !< diffusion coefficient of the gas involved5304 5297 5305 5298 REAL(wp), OPTIONAL,INTENT(IN) :: p !< pressure (Pa) … … 5324 5317 CASE( 'NO2', 'O3', 'SO2', 'NH3' ) 5325 5318 ! 5326 !-- if vegetation present:5319 !-- If vegetation present: 5327 5320 IF ( lai_present ) THEN 5328 5321 … … 5330 5323 CALL rc_get_vpd( t, rh, vpd ) 5331 5324 CALL rc_gstom_emb( lu, solar_rad, t, vpd, lai_present, lai, sinphi, gstom, p ) 5332 gstom = gstom * diffusivity / dO3 !< Gstom of Emberson is derived for ozone 5325 gstom = gstom * diffusivity / dO3 !< Gstom of Emberson is derived for ozone 5333 5326 ELSE 5334 5327 gstom = 0.0_wp … … 5336 5329 ELSE 5337 5330 ! 5338 !-- no vegetation; zero conductance (infinite resistance):5331 !-- No vegetation; zero conductance (infinite resistance): 5339 5332 gstom = 0.0_wp 5340 5333 ENDIF … … 5348 5341 5349 5342 5350 !------------------------------------------------------------------------------ !5343 !--------------------------------------------------------------------------------------------------! 5351 5344 ! Description: 5352 5345 ! ------------ 5353 5346 !> Subroutine to compute stomatal conductance according to Emberson 5354 !------------------------------------------------------------------------------ !5347 !--------------------------------------------------------------------------------------------------! 5355 5348 SUBROUTINE rc_gstom_emb( lu, solar_rad, T, vpd, lai_present, lai, sinp, Gsto, p ) 5356 5349 ! … … 5360 5353 !> Updated and extended. 5361 5354 !> 2009-09, Arjo Segers, TNO 5362 !> Limitted temperature influence to range to avoid 5363 !> floating point exceptions. 5355 !> Limitted temperature influence to range to avoid floating point exceptions. 5364 5356 5365 5357 !> Method … … 5391 5383 LOGICAL, INTENT(IN) :: lai_present 5392 5384 5385 REAL(wp), INTENT(IN) :: lai !< one-sided leaf area index 5386 REAL(wp), INTENT(IN) :: sinp !< sin of solar elevation angle 5393 5387 REAL(wp), INTENT(IN) :: solar_rad !< solar radiation, dirict+diffuse (W/m2) 5394 5388 REAL(wp), INTENT(IN) :: t !< temperature (C) 5395 5389 REAL(wp), INTENT(IN) :: vpd !< vapour pressure deficit (kPa) 5396 5390 5397 REAL(wp), INTENT(IN) :: lai !< one-sided leaf area index5398 REAL(wp), INTENT(IN) :: sinp !< sin of solar elevation angle5399 5391 5400 5392 REAL(wp), OPTIONAL, INTENT(IN) :: p !< pressure (Pa) … … 5403 5395 ! 5404 5396 !-- Local variables: 5397 REAL(wp) :: bt 5398 REAL(wp) :: f_env 5405 5399 REAL(wp) :: f_light 5406 5400 REAL(wp) :: f_phen 5407 5401 REAL(wp) :: f_temp 5402 REAL(wp) :: f_swp 5408 5403 REAL(wp) :: f_vpd 5409 REAL(wp) :: f_swp5410 REAL(wp) :: bt5411 REAL(wp) :: f_env5404 REAL(wp) :: laishade 5405 REAL(wp) :: laisun 5406 REAL(wp) :: pardiff 5412 5407 REAL(wp) :: pardir 5413 REAL(wp) :: pardiff5414 5408 REAL(wp) :: parshade 5415 5409 REAL(wp) :: parsun 5416 REAL(wp) :: laisun 5417 REAL(wp) :: laishade 5410 REAL(wp) :: pres 5418 5411 REAL(wp) :: sinphi 5419 REAL(wp) :: pres 5412 5420 5413 REAL(wp), PARAMETER :: p_sealevel = 1.01325e05 !< Pa 5421 5414 ! … … 5423 5416 IF ( lai_present ) THEN 5424 5417 5425 ! calculation of correction factors for stomatal conductance5426 IF ( sinp <= 0.0_wp ) THEN 5418 ! Calculation of correction factors for stomatal conductance 5419 IF ( sinp <= 0.0_wp ) THEN 5427 5420 sinphi = 0.0001_wp 5428 5421 ELSE … … 5430 5423 END IF 5431 5424 ! 5432 !-- ratio between actual and sea-level pressure is used 5433 !-- to correct for height in the computation of par; 5434 !-- should not exceed sea-level pressure therefore ... 5435 IF ( present(p) ) THEN 5436 pres = min( p, p_sealevel ) 5437 ELSE 5425 !-- Ratio between actual and sea-level pressure is used to correct for height in the computation 5426 !-- of par; should not exceed sea-level pressure therefore ... 5427 IF ( PRESENT( p ) ) THEN 5428 pres = MIN( p, p_sealevel ) 5429 ELSE 5438 5430 pres = p_sealevel 5439 5431 ENDIF 5440 5432 ! 5441 !-- direct and diffuse par, Photoactive (=visible) radiation:5433 !-- Direct and diffuse par, Photoactive (=visible) radiation: 5442 5434 CALL par_dir_diff( solar_rad, sinphi, pres, p_sealevel, pardir, pardiff ) 5443 5435 ! 5444 !-- par for shaded leaves (canopy averaged): 5445 parshade = pardiff * exp( -0.5 * lai**0.7 ) + 0.07 * pardir * ( 1.1 - 0.1 * lai ) * exp( -sinphi ) !< Norman,1982 5446 IF ( solar_rad > 200.0_wp .AND. lai > 2.5_wp ) THEN 5447 parshade = pardiff * exp( -0.5 * lai**0.8 ) + 0.07 * pardir * ( 1.1 - 0.1 * lai ) * exp( -sinphi ) !< Zhang et al., 2001 5436 !-- Par for shaded leaves (canopy averaged): 5437 parshade = pardiff * EXP( -0.5 * lai**0.7 ) + 0.07 * pardir * ( 1.1 - 0.1 * lai ) * & 5438 EXP( -sinphi ) !< Norman,1982 5439 IF ( solar_rad > 200.0_wp .AND. lai > 2.5_wp ) THEN 5440 parshade = pardiff * EXP( -0.5 * lai**0.8 ) + 0.07 * pardir * ( 1.1 - 0.1 * lai ) * & 5441 EXP( -sinphi ) !< Zhang et al., 2001 5448 5442 END IF 5449 5443 ! 5450 !-- par for sunlit leaves (canopy averaged):5444 !-- Par for sunlit leaves (canopy averaged): 5451 5445 !-- alpha -> mean angle between leaves and the sun is fixed at 60 deg -> i.e. cos alpha = 0.5 5452 5446 parsun = pardir * 0.5/sinphi + parshade !< Norman, 1982 5453 IF ( solar_rad > 200.0_wp .AND.lai > 2.5_wp ) THEN5447 IF ( solar_rad > 200.0_wp .AND. lai > 2.5_wp ) THEN 5454 5448 parsun = pardir**0.8 * 0.5 / sinphi + parshade !< Zhang et al., 2001 5455 5449 END IF 5456 5450 ! 5457 !-- leaf area index for sunlit and shaded leaves:5451 !-- Leaf area index for sunlit and shaded leaves: 5458 5452 IF ( sinphi > 0 ) THEN 5459 laisun = 2 * sinphi * ( 1 - exp( -0.5 * lai / sinphi ) )5453 laisun = 2 * sinphi * ( 1 - EXP( -0.5 * lai / sinphi ) ) 5460 5454 laishade = lai - laisun 5461 5455 ELSE … … 5464 5458 END IF 5465 5459 5466 f_light = ( laisun * ( 1 - exp( -1.0_wp * alpha(lu) * parsun ) ) +&5467 laishade * ( 1 - exp( -1.0_wp * alpha(lu) * parshade ) ) ) / lai5460 f_light = ( laisun * ( 1 - EXP( -1.0_wp * alpha(lu) * parsun ) ) + & 5461 laishade * ( 1 - EXP( -1.0_wp * alpha(lu) * parshade ) ) ) / lai 5468 5462 5469 5463 f_light = MAX(f_light,f_min(lu)) 5470 5464 ! 5471 !-- temperature influence; only non-zero within range [tmin,tmax]:5472 IF ( ( tmin(lu) < t ) .AND.( t < tmax(lu) ) ) THEN5465 !-- Temperature influence; only non-zero within range [tmin,tmax]: 5466 IF ( ( tmin(lu) < t ) .AND. ( t < tmax(lu) ) ) THEN 5473 5467 bt = ( tmax(lu) - topt(lu) ) / ( topt(lu) - tmin(lu) ) 5474 f_temp = ( ( t - tmin(lu) ) / ( topt(lu) - tmin(lu) ) ) * ( ( tmax(lu) - t ) / ( tmax(lu) - topt(lu) ) )**bt 5468 f_temp = ( ( t - tmin(lu) ) / ( topt(lu) - tmin(lu) ) ) * & 5469 ( ( tmax(lu) - t ) / ( tmax(lu) - topt(lu) ) )**bt 5475 5470 ELSE 5476 5471 f_temp = 0.0_wp … … 5478 5473 f_temp = MAX( f_temp, f_min(lu) ) 5479 5474 ! 5480 !-- vapour pressure deficit influence 5481 f_vpd = MIN( 1.0_wp, ( ( 1.0_wp - f_min(lu) ) * ( vpd_min(lu) - vpd ) / ( vpd_min(lu) - vpd_max(lu) ) + f_min(lu) ) ) 5475 !-- Vapour pressure deficit influence 5476 f_vpd = MIN( 1.0_wp, ( ( 1.0_wp - f_min(lu) ) * ( vpd_min(lu) - vpd ) / & 5477 ( vpd_min(lu) - vpd_max(lu) ) + f_min(lu) ) ) 5482 5478 f_vpd = MAX( f_vpd, f_min(lu) ) 5483 5479 5484 5480 f_swp = 1.0_wp 5485 5481 ! 5486 !-- influence of phenology on stom. conductance 5487 !-- ignored for now in DEPAC since influence of f_phen on lu classes in use is negligible. 5488 !-- When other EMEP classes (e.g. med. broadleaf) are used f_phen might be too important to ignore 5482 !-- Influence of phenology on stom. conductance 5483 !-- Ignored for now in DEPAC since influence of f_phen on lu classes in use is negligible. 5484 !-- When other EMEP classes (e.g. med. broadleaf) are used f_phen might be too important to 5485 !-- ignore. 5489 5486 f_phen = 1.0_wp 5490 5487 ! 5491 !-- evaluate total stomatal conductance5488 !-- Evaluate total stomatal conductance 5492 5489 f_env = f_temp * f_vpd * f_swp 5493 5490 f_env = MAX( f_env,f_min(lu) ) 5494 5491 gsto = g_max(lu) * f_light * f_phen * f_env 5495 5492 ! 5496 !-- 5497 !-- this is converted with lai to m2 surface.5493 !-- gstom expressed per m2 leafarea; 5494 !-- This is converted with lai to m2 surface. 5498 5495 gsto = lai * gsto ! in m/s 5499 5496 … … 5505 5502 5506 5503 5507 !------------------------------------------------------------------- 5504 !--------------------------------------------------------------------------------------------------! 5508 5505 !> par_dir_diff 5509 !> Weiss, A., Norman, J.M. (1985) Partitioning solar radiation into direct and 5510 !> diffuse, visible and near-infrared components. Agric. Forest Meteorol. 5511 !> 34, 205-213. 5506 !> Weiss, A., Norman, J.M. (1985) Partitioning solar radiation into direct and diffuse, visible 5507 !> and near-infrared components. Agric. Forest Meteorol. 34, 205-213. 5512 5508 !> From a SUBROUTINE obtained from Leiming Zhang, 5513 5509 !> Meteorological Service of Canada … … 5515 5511 !> Willem Asman set it to global radiation (here defined as solar radiation, dirict+diffuse) 5516 5512 !> 5517 !> @todo Check/connect/replace with radiation_model_mod variables 5518 !------------------------------------------------------------------- 5513 !> @todo Check/connect/replace with radiation_model_mod variables 5514 !-------------------------------------------------------------------------------------------------! 5519 5515 SUBROUTINE par_dir_diff( solar_rad, sinphi, pres, pres_0, par_dir, par_diff ) 5520 5516 5521 5517 5522 REAL(wp), INTENT(IN) :: solar_rad !< solar radiation, dirict+diffuse (W m-2)5523 REAL(wp), INTENT(IN) :: sinphi !< sine of the solar elevation5524 5518 REAL(wp), INTENT(IN) :: pres !< actual pressure (to correct for height) (Pa) 5525 5519 REAL(wp), INTENT(IN) :: pres_0 !< pressure at sea level (Pa) 5526 5527 REAL(wp), INTENT(OUT) :: par_dir !< par direct : visible (photoactive) direct beam radiation (W m-2) 5528 REAL(wp), INTENT(OUT) :: par_diff !< par diffuse: visible (photoactive) diffuse radiation (W m-2) 5529 5530 5531 REAL(wp) :: sv !< total visible radiation 5520 REAL(wp), INTENT(IN) :: sinphi !< sine of the solar elevation 5521 REAL(wp), INTENT(IN) :: solar_rad !< solar radiation, dirict+diffuse (W m-2) 5522 5523 REAL(wp), INTENT(OUT) :: par_diff !< par diffuse: visible (photoactive) diffuse radiation 5524 !< (W m-2) 5525 REAL(wp), INTENT(OUT) :: par_dir !< par direct : visible (photoactive) direct beam 5526 !< radiation (W m-2) 5527 5532 5528 REAL(wp) :: fv !< par direct beam fraction (dimensionless) 5533 REAL(wp) :: ratio !< ratio measured to potential solar radiation (dimensionless) 5534 REAL(wp) :: rdm !< potential direct beam near-infrared radiation (W m-2); "potential" means clear-sky 5529 REAL(wp) :: ratio !< ratio measured to potential solar radiation 5530 !< (dimensionless) 5531 REAL(wp) :: rdm !< potential direct beam near-infrared radiation 5532 !< (W m-2); "potential" means clear-sky 5535 5533 REAL(wp) :: rdn !< potential diffuse near-infrared radiation (W m-2) 5536 5534 REAL(wp) :: rdu !< visible (par) direct beam radiation (W m-2) … … 5538 5536 REAL(wp) :: rn !< near-infrared radiation (W m-2) 5539 5537 REAL(wp) :: rv !< visible radiation (W m-2) 5540 REAL(wp) :: ww !< water absorption in the near infrared for 10 mm of precipitable water 5538 REAL(wp) :: sv !< total visible radiation 5539 REAL(wp) :: ww !< water absorption in the near infrared for 10 mm of 5540 !< precipitable water 5541 5541 5542 5542 ! 5543 5543 !-- Calculate visible (PAR) direct beam radiation 5544 !-- 600 W m-2 represents average amount of par (400-700 nm wavelength) 5545 !-- at the top of the atmosphere;this is roughly 0.45*solar constant (solar constant=1320 Wm-2)5546 rdu = 600.0_wp* exp( -0.185_wp * ( pres / pres_0 ) / sinphi ) * sinphi5544 !-- 600 W m-2 represents average amount of par (400-700 nm wavelength) at the top of the atmosphere; 5545 !-- this is roughly 0.45*solar constant (solar constant=1320 Wm-2) 5546 rdu = 600.0_wp* EXP( -0.185_wp * ( pres / pres_0 ) / sinphi ) * sinphi 5547 5547 ! 5548 5548 !-- Calculate potential visible diffuse radiation … … 5550 5550 ! 5551 5551 !-- Calculate the water absorption in the-near infrared 5552 ww = 1320 * 10**( -1.195_wp + 0.4459_wp * log10( 1.0_wp / sinphi ) - 0.0345_wp * ( log10( 1.0_wp / sinphi ) )**2 ) 5552 ww = 1320 * 10**( -1.195_wp + 0.4459_wp * LOG10( 1.0_wp / sinphi ) - 0.0345_wp * & 5553 ( LOG10( 1.0_wp / sinphi ) )**2 ) 5553 5554 ! 5554 5555 !-- Calculate potential direct beam near-infrared radiation 5555 rdm = (720.0_wp * exp(-0.06_wp * (pres / pres_0) / sinphi ) - ww ) * sinphi !< 720 = solar constant - 600 5556 rdm = ( 720.0_wp * EXP( -0.06_wp * ( pres / pres_0) / sinphi ) - ww ) * sinphi !< 720 = solar 5557 !< constant - 600 5556 5558 ! 5557 5559 !-- Calculate potential diffuse near-infrared radiation … … 5563 5565 ! 5564 5566 !-- Compute ratio between input global radiation (here defined as solar radiation, dirict+diffuse) 5565 !-- and total radiation computed here 5567 !-- and total radiation computed here. 5566 5568 ratio = MIN( 0.89_wp, solar_rad / ( rv + rn ) ) 5567 5569 ! … … 5571 5573 !-- Calculate fraction of par in the direct beam 5572 5574 fv = MIN( 0.99_wp, ( 0.9_wp - ratio ) / 0.7_wp ) !< help variable 5573 fv = MAX( 0.01_wp, rdu / rv * ( 1.0_wp - fv**0.6667_wp ) ) !< fraction of par in the direct beam 5575 fv = MAX( 0.01_wp, rdu / rv * ( 1.0_wp - fv**0.6667_wp ) ) !< fraction of par in the direct 5576 !< beam 5574 5577 ! 5575 5578 !-- Compute direct and diffuse parts of par … … 5579 5582 END SUBROUTINE par_dir_diff 5580 5583 5581 5582 !------------------------------------------------------------------- 5583 5584 !------------------------------------------------------------------- 5584 5585 !--------------------------------------------------------------------------------------------------! 5586 !> rc_get_vpd: get vapour pressure deficit (kPa) 5587 !--------------------------------------------------------------------------------------------------! 5585 5588 SUBROUTINE rc_get_vpd( temp, rh, vpd ) 5586 5589 5587 5590 ! 5588 5591 !-- Input/output variables: 5592 REAL(wp), INTENT(IN) :: rh !< relative humidity (%) 5589 5593 REAL(wp), INTENT(IN) :: temp !< temperature (C) 5590 REAL(wp), INTENT(IN) :: rh !< relative humidity (%)5591 5594 5592 5595 REAL(wp), INTENT(OUT) :: vpd !< vapour pressure deficit (kPa) … … 5595 5598 REAL(wp) :: esat 5596 5599 ! 5597 !-- fit parameters:5600 !-- Fit parameters: 5598 5601 REAL(wp), PARAMETER :: a1 = 6.113718e-01 5599 5602 REAL(wp), PARAMETER :: a2 = 4.43839e-02 … … 5603 5606 REAL(wp), PARAMETER :: a6 = 3.0e-09 5604 5607 ! 5605 !-- esat is saturation vapour pressure (kPa) at temp(C) following Monteith (1973)5608 !-- esat is saturation vapour pressure (kPa) at temp(C) following Monteith (1973) 5606 5609 esat = a1 + a2 * temp + a3 * temp**2 + a4 * temp**3 + a5 * temp**4 + a6 * temp**5 5607 5610 vpd = esat * ( 1 - rh / 100 ) … … 5610 5613 5611 5614 5612 !------------------------------------------------------------------- 5613 5614 !------------------------------------------------------------------- 5615 !--------------------------------------------------------------------------------------------------! 5616 !> rc_gsoil_eff: compute effective soil conductance 5617 !--------------------------------------------------------------------------------------------------! 5615 5618 SUBROUTINE rc_gsoil_eff( icmp, lu, sai, ust, nwet, t, gsoil_eff ) 5616 5619 … … 5618 5621 !-- Input/output variables: 5619 5622 INTEGER(iwp), INTENT(IN) :: icmp !< component index 5620 INTEGER(iwp), INTENT(IN) :: lu !< land use type, lu = 1,..., nlu5621 5623 INTEGER(iwp), INTENT(IN) :: nwet !< index for wetness 5622 5624 !< nwet = 0 -> dry; nwet = 1 -> wet; nwet = 9 -> snow 5623 5625 !< N.B. this routine cannot be called with nwet = 9, 5624 5626 !< nwet = 9 should be handled outside this routine. 5627 INTEGER(iwp), INTENT(IN) :: lu !< land use type, lu = 1,..., nlu 5628 5625 5629 REAL(wp), INTENT(IN) :: sai !< surface area index 5630 REAL(wp), INTENT(IN) :: t !< temperature (C) 5626 5631 REAL(wp), INTENT(IN) :: ust !< friction velocity (m/s) 5627 REAL(wp), INTENT(IN) :: t !< temperature (C) 5632 5628 5633 REAL(wp), INTENT(OUT) :: gsoil_eff !< effective soil conductance (m/s) 5629 5634 ! … … 5634 5639 !-- Soil resistance (numbers matched with lu_classes and component numbers) 5635 5640 ! grs ara crp cnf dec wat urb oth des ice sav trf wai med sem 5636 REAL(wp), PARAMETER :: rsoil(nlu_dep,ncmp) = reshape( (/&5641 REAL(wp), PARAMETER :: rsoil(nlu_dep,ncmp) = RESHAPE( (/ & 5637 5642 1000., 200., 200., 200., 200., 2000., 400., 1000., 2000., 2000., 1000., 200., 2000., 200., 400., & !< O3 5638 5643 1000., 1000., 1000., 1000., 1000., 10., 1000., 1000., 1000., 500., 1000., 1000., 10., 1000., 1000., & !< SO2 … … 5640 5645 -999., -999., -999., -999., -999., 2000., 1000., -999., 2000., 2000., -999., -999., 2000., -999., -999., & !< NO 5641 5646 100., 100., 100., 100., 100., 10., 100., 100., 100., 1000., 100., 100., 10., 100., 100., & !< NH3 5642 -999., -999., -999., -999., -999., 2000., 1000., -999., 2000., 2000., -999., -999., 2000., -999., -999., & !< CO 5643 -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., & !< NO3 5647 -999., -999., -999., -999., -999., 2000., 1000., -999., 2000., 2000., -999., -999., 2000., -999., -999., & !< CO 5648 -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., & !< NO3 5644 5649 -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., & !< HNO3 5645 5650 -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., & !< N2O5 5646 -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999. /),& !< H2O2 5651 -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999., -999. /),& !< H2O2 5647 5652 (/nlu_dep,ncmp/) ) 5648 5653 ! 5649 5654 !-- For o3 so2 no2 no nh3 co no3 hno3 n2o5 h2o2 5650 REAL(wp), PARAMETER :: rsoil_ wet(ncmp) = (/2000., 10. , 2000., -999., 10. , -999., -999., -999., -999., -999./)5651 REAL(wp), PARAMETER :: rsoil_ frozen(ncmp) = (/2000., 500., 2000., -999., 1000., -999., -999., -999., -999., -999./)5655 REAL(wp), PARAMETER :: rsoil_frozen(ncmp) = (/ 2000., 500., 2000., -999., 1000., -999., -999., -999., -999., -999. /) 5656 REAL(wp), PARAMETER :: rsoil_wet(ncmp) = (/ 2000., 10. , 2000., -999., 10. , -999., -999., -999., -999., -999. /) 5652 5657 ! 5653 5658 !-- Compute in canopy (in crop) resistance: … … 5700 5705 5701 5706 5702 !------------------------------------------------------------------- 5703 !> rc_rinc: compute in canopy (or in crop) resistance 5704 !> van Pul and Jacobs, 1993, BLM 5705 !------------------------------------------------------------------- 5707 !--------------------------------------------------------------------------------------------------! 5708 !> rc_rinc: compute in canopy (or in crop) resistance van Pul and Jacobs, 1993, BLM 5709 !--------------------------------------------------------------------------------------------------! 5706 5710 SUBROUTINE rc_rinc( lu, sai, ust, rinc ) 5707 5711 … … 5715 5719 REAL(wp), INTENT(OUT) :: rinc !< in canopy resistance (s/m) 5716 5720 ! 5717 !-- b = empirical constant for computation of rinc (in canopy resistance) (= 14 m-1 or -999 if not applicable) 5721 !-- b = empirical constant for computation of rinc (in canopy resistance) (= 14 m-1 or -999 if not 5722 !-- applicable) 5718 5723 !-- h = vegetation height (m) gra ara crop con dec wat urb oth des ice sav trf wai med semi 5719 5724 REAL(wp), DIMENSION(nlu_dep), PARAMETER :: b = (/ -999, 14, 14, 14, 14, -999, -999, -999, -999, -999, -999, 14, -999, & … … 5724 5729 !-- Compute Rinc only for arable land, perm. crops, forest; otherwise Rinc = 0: 5725 5730 IF ( b(lu) > 0.0_wp ) THEN 5726 ! !5731 ! 5727 5732 !-- Check for u* > 0 (otherwise denominator = 0): 5728 5733 IF ( ust > 0.0_wp ) THEN … … 5732 5737 ENDIF 5733 5738 ELSE 5734 IF ( lu == ilu_grass .OR. lu == ilu_other) THEN5739 IF ( lu == ilu_grass .OR. lu == ilu_other ) THEN 5735 5740 rinc = -999.0_wp !< no deposition path for grass, other, and semi-natural 5736 5741 ELSE … … 5742 5747 5743 5748 5744 !------------------------------------------------------------------- 5745 5746 !------------------------------------------------------------------- 5749 !--------------------------------------------------------------------------------------------------! 5750 !> rc_rctot: compute total canopy (or surface) resistance Rc 5751 !--------------------------------------------------------------------------------------------------! 5747 5752 SUBROUTINE rc_rctot( gstom, gsoil_eff, gw, gc_tot, rc_tot ) 5748 5753 5749 5754 ! 5750 5755 !-- Input/output variables: 5756 REAL(wp), INTENT(IN) :: gsoil_eff !< effective soil conductance (s/m) 5751 5757 REAL(wp), INTENT(IN) :: gstom !< stomatal conductance (s/m) 5752 REAL(wp), INTENT(IN) :: gsoil_eff !< effective soil conductance (s/m)5753 5758 REAL(wp), INTENT(IN) :: gw !< external leaf conductance (s/m) 5754 5759 … … 5769 5774 5770 5775 5771 !------------------------------------------------------------------- 5772 !> rc_comp_point_rc_eff: calculate the effective resistance Rc 5773 !> based on one or more compensation points 5774 !------------------------------------------------------------------- 5775 !> NH3rc (see depac v3.6 is based on Avero workshop Marc Sutton. p. 173. 5776 !> Sutton 1998 AE 473-480) 5777 !> 5778 !> Documentation by Ferd Sauter, 2008; see also documentation block in header of depac subroutine. 5779 !> FS 2009-01-29: variable names made consistent with DEPAC 5780 !> FS 2009-03-04: use total compensation point 5781 !> 5782 !> C: with total compensation point ! D: approximation of C 5783 !> ! with classical approach 5784 !> zr --------- Catm ! zr --------- Catm 5785 !> | ! | 5786 !> Ra ! Ra 5787 !> | ! | 5788 !> Rb ! Rb 5789 !> | ! | 5790 !> z0 --------- Cc ! z0 --------- Cc 5791 !> | ! | 5792 !> Rc ! Rc_eff 5793 !> | ! | 5794 !> --------- Ccomp_tot ! --------- C=0 5795 !> 5796 !> 5797 !> The effective Rc is defined such that instead of using 5798 !> 5799 !> F = -vd*[Catm - Ccomp_tot] (1) 5800 !> 5801 !> we can use the 'normal' flux formula 5802 !> 5803 !> F = -vd'*Catm, (2) 5804 !> 5805 !> with vd' = 1/(Ra + Rb + Rc') (3) 5806 !> 5807 !> and Rc' the effective Rc (rc_eff). 5808 !> (Catm - Ccomp_tot) 5809 !> vd'*Catm = vd*(Catm - Ccomp_tot) <=> vd' = vd* ------------------ 5810 !> Catm 5811 !> 5812 !> (Catm - Ccomp_tot) 5813 !> 1/(Ra + Rb + Rc') = (1/Ra + Rb + Rc) * ------------------ 5814 !> Catm 5815 !> 5816 !> Catm 5817 !> (Ra + Rb + Rc') = (Ra + Rb + Rc) * ------------------ 5818 !> (Catm - Ccomp_tot) 5819 !> 5820 !> Catm 5821 !> Rc' = (Ra + Rb + Rc) * ------------------ - Ra - Rb 5822 !> (Catm - Ccomp_tot) 5823 !> 5824 !> Catm Catm 5825 !> Rc' = (Ra + Rb) [------------------ - 1 ] + Rc * ------------------ 5826 !> (Catm - Ccomp_tot) (Catm - Ccomp_tot) 5827 !> 5828 !> Rc' = [(Ra + Rb)*Ccomp_tot + Rc*Catm ] / (Catm - Ccomp_tot) 5829 !> 5830 ! ------------------------------------------------------------------------------------------- 5776 !--------------------------------------------------------------------------------------------------! 5777 !> rc_comp_point_rc_eff: calculate the effective resistance Rc 5778 !> based on one or more compensation points 5779 !--------------------------------------------------------------------------------------------------! 5780 !> NH3rc (see depac v3.6 is based on Avero workshop Marc Sutton. p. 173. Sutton 1998 AE 473-480) 5781 !> 5782 !> Documentation by Ferd Sauter, 2008; see also documentation block in header of depac subroutine. 5783 !> FS 2009-01-29: variable names made consistent with DEPAC 5784 !> FS 2009-03-04: use total compensation point 5785 !> 5786 !> C: with total compensation point ! D: approximation of C 5787 !> ! with classical approach 5788 !> zr --------- Catm ! zr --------- Catm 5789 !> | ! | 5790 !> Ra ! Ra 5791 !> | ! | 5792 !> Rb ! Rb 5793 !> | ! | 5794 !> z0 --------- Cc ! z0 --------- Cc 5795 !> | ! | 5796 !> Rc ! Rc_eff 5797 !> | ! | 5798 !> --------- Ccomp_tot ! --------- C=0 5799 !> 5800 !> 5801 !> The effective Rc is defined such that instead of using 5802 !> 5803 !> F = -vd*[Catm - Ccomp_tot] (1) 5804 !> 5805 !> we can use the 'normal' flux formula 5806 !> 5807 !> F = -vd'*Catm, (2) 5808 !> 5809 !> with vd' = 1/(Ra + Rb + Rc') (3) 5810 !> 5811 !> and Rc' the effective Rc (rc_eff). 5812 !> (Catm - Ccomp_tot) 5813 !> vd'*Catm = vd*(Catm - Ccomp_tot) <=> vd' = vd* ------------------ 5814 !> Catm 5815 !> 5816 !> (Catm - Ccomp_tot) 5817 !> 1/(Ra + Rb + Rc') = (1/Ra + Rb + Rc) * ------------------ 5818 !> Catm 5819 !> 5820 !> Catm 5821 !> (Ra + Rb + Rc') = (Ra + Rb + Rc) * ------------------ 5822 !> (Catm - Ccomp_tot) 5823 !> 5824 !> Catm 5825 !> Rc' = (Ra + Rb + Rc) * ------------------ - Ra - Rb 5826 !> (Catm - Ccomp_tot) 5827 !> 5828 !> Catm Catm 5829 !> Rc' = (Ra + Rb) [------------------ - 1 ] + Rc * ------------------ 5830 !> (Catm - Ccomp_tot) (Catm - Ccomp_tot) 5831 !> 5832 !> Rc' = [(Ra + Rb)*Ccomp_tot + Rc*Catm ] / (Catm - Ccomp_tot) 5833 !> 5834 ! ------------------------------------------------------------------------------------------- 5831 5835 ! SUBROUTINE rc_comp_point_rc_eff( ccomp_tot, conc_ijk_ugm3, ra, rb, rc_tot, rc_eff ) 5832 5836 ! … … 5843 5847 ! ! 5844 5848 !!-- Compute effective resistance: 5845 ! IF ( 5849 ! IF ( ccomp_tot == 0.0_wp ) THEN 5846 5850 ! ! 5847 !!-- trace with no compensiation point ( or compensation point equal to zero)5851 !!-- Trace with no compensiation point ( or compensation point equal to zero) 5848 5852 ! rc_eff = rc_tot 5849 5853 ! 5850 ! ELSE IF ( ccomp_tot > 0.0_wp .AND.( abs( conc_ijk_ugm3 - ccomp_tot ) < 1.e-8 ) ) THEN5854 ! ELSE IF ( ccomp_tot > 0.0_wp .AND. ( abs( conc_ijk_ugm3 - ccomp_tot ) < 1.e-8 ) ) THEN 5851 5855 ! ! 5852 !!-- surface concentration (almost) equal to atmospheric concentration5856 !!-- Surface concentration (almost) equal to atmospheric concentration 5853 5857 !!-- no exchange between surface and atmosphere, infinite RC --> vd=0 5854 5858 ! rc_eff = 9999999999.0_wp … … 5856 5860 ! ELSE IF ( ccomp_tot > 0.0_wp ) THEN 5857 5861 ! ! 5858 !!-- compensation point available, calculate effective resistance5862 !!-- Compensation point available, calculate effective resistance 5859 5863 ! rc_eff = ( ( ra + rb ) * ccomp_tot + rc_tot * conc_ijk_ugm3 ) / ( conc_ijk_ugm3 - ccomp_tot ) 5860 5864 ! … … 5866 5870 ! 5867 5871 ! RETURN 5868 ! 5872 ! 5869 5873 ! END SUBROUTINE rc_comp_point_rc_eff 5870 5874 5871 5875 5872 !------------------------------------------------------------------- 5873 !> missing: check for data that correspond with a missing deposition path 5874 !> this data is representedby -9995875 !------------------------------------------------------------------- 5876 !--------------------------------------------------------------------------------------------------! 5877 !> missing: check for data that correspond with a missing deposition path this data is represented 5878 !> by -999 5879 !--------------------------------------------------------------------------------------------------! 5876 5880 LOGICAL function missing( x ) 5877 5881 … … 5879 5883 5880 5884 ! 5881 !-- bandwidth for checking (in)equalities of floats5885 !-- Bandwidth for checking (in)equalities of floats 5882 5886 REAL(wp), PARAMETER :: eps = 1.0e-5 5883 5887 5884 missing = ( abs(x + 999.0_wp) <= eps)5888 missing = ( ABS( x + 999.0_wp ) <= eps ) 5885 5889 5886 5890 END function missing … … 5891 5895 ! 5892 5896 !-- in/out 5893 5894 5897 REAL(wp), INTENT(IN) :: rhopart !< particle density (kg/m3) 5895 5898 REAL(wp), INTENT(IN) :: partsize !< particle size (m) … … 5907 5910 END FUNCTION sedimentation_velocity 5908 5911 5909 5910 !------------------------------------------------------------------------ 5912 5913 !-------------------------------------------------------------------------------------------------! 5911 5914 !> Boundary-layer deposition resistance following Zhang (2001) 5912 !------------------------------------------------------------------------ 5913 SUBROUTINE drydepo_aero_zhang_vd( vd, rs, vs1, partsize, slipcor, nwet, tsurf, dens1, viscos1, &5914 luc, ftop_lu, ustar )5915 5916 ! 5917 !-- in/out 5918 5915 !-------------------------------------------------------------------------------------------------! 5916 SUBROUTINE drydepo_aero_zhang_vd( vd, rs, vs1, partsize, slipcor, nwet, tsurf, dens1, viscos1, & 5917 luc, ftop_lu, ustar ) 5918 5919 ! 5920 !-- in/out 5921 INTEGER(iwp), INTENT(IN) :: luc !< DEPAC LU 5919 5922 INTEGER(iwp), INTENT(IN) :: nwet !< 1=rain, 9=snowcover 5920 INTEGER(iwp), INTENT(IN) :: luc !< DEPAC LU 5921 5922 REAL(wp), INTENT(IN) :: vs1 !< sedimentation velocity in lowest layer5923 5924 REAL(wp), INTENT(IN) :: dens1 !< air density (kg/m3) in lowest layer 5925 REAL(wp), INTENT(IN) :: ftop_lu !< atmospheric resistnace Ra 5923 5926 REAL(wp), INTENT(IN) :: partsize !< particle diameter (m) 5924 5927 REAL(wp), INTENT(IN) :: slipcor !< slip correction factor 5925 5928 REAL(wp), INTENT(IN) :: tsurf !< surface temperature (K) 5926 REAL(wp), INTENT(IN) :: dens1 !< air density (kg/m3) in lowest layer5929 REAL(wp), INTENT(IN) :: ustar !< friction velocity u* 5927 5930 REAL(wp), INTENT(IN) :: viscos1 !< air viscosity in lowest layer 5928 REAL(wp), INTENT(IN) :: ftop_lu !< atmospheric resistnace Ra5929 REAL(wp), INTENT(IN) :: ustar !< friction velocity u* 5930 5931 REAL(wp), INTENT(IN) :: vs1 !< sedimentation velocity in lowest layer 5932 5933 REAL(wp), INTENT(OUT) :: rs !< sedimentaion resistance (s/m) 5931 5934 REAL(wp), INTENT(OUT) :: vd !< deposition velocity (m/s) 5932 REAL(wp), INTENT(OUT) :: rs !< sedimentaion resistance (s/m) 5933 ! 5934 !-- constants 5935 5935 ! 5936 !-- Constants 5936 5937 REAL(wp), PARAMETER :: grav = 9.80665_wp !< acceleration of gravity (m/s2) 5937 5938 5938 REAL(wp), PARAMETER :: epsilon0 = 3.0_wp 5939 5939 REAL(wp), PARAMETER :: kb = 1.38066E-23_wp 5940 5940 REAL(wp), PARAMETER :: pi = 3.141592654_wp !< pi 5941 5941 5942 REAL(wp), PARAMETER :: alfa_lu(nlu_dep) = & 5943 (/ 1.2_wp, 1.2_wp, 1.2_wp, 1.0_wp, 1.0_wp, 100.0_wp, 1.5_wp, 1.2_wp, 50.0_wp, 100.0_wp, &5944 1.2_wp, 1.0_wp, 100.0_wp, 1.2_wp, 50.0_wp/)5942 REAL(wp), PARAMETER :: alfa_lu(nlu_dep) = & 5943 (/ 1.2_wp, 1.2_wp, 1.2_wp, 1.0_wp, 1.0_wp, 100.0_wp, 1.5_wp, 1.2_wp, 50.0_wp, 100.0_wp, & 5944 1.2_wp, 1.0_wp, 100.0_wp, 1.2_wp, 50.0_wp /) 5945 5945 REAL(wp), PARAMETER :: gamma_lu(nlu_dep) = & 5946 (/ 0.54_wp, 0.54_wp, 0.54_wp, 0.56_wp, 0.56_wp, 0.50_wp, 0.56_wp, 0.54_wp, 0.58_wp, 0.50_wp, &5947 0.54_wp, 0.56_wp, 0.50_wp, 0.54_wp, 0.54_wp /)5948 REAL(wp), PARAMETER ::A_lu(nlu_dep) = & 5949 (/ 3.0_wp, 3.0_wp, 2.0_wp, 2.0_wp, 7.0_wp, -99.0_wp, 10.0_wp, 3.0_wp, -99.0_wp, -99.0_wp, &5950 3.0_wp, 7.0_wp, -99.0_wp, 2.0_wp, -99.0_wp /)5951 ! 5952 !-- grass arabl crops conif decid water urba othr desr ice sav trf wai med sem 5946 (/ 0.54_wp, 0.54_wp, 0.54_wp, 0.56_wp, 0.56_wp, 0.50_wp, 0.56_wp, 0.54_wp, 0.58_wp, 0.50_wp, & 5947 0.54_wp, 0.56_wp, 0.50_wp, 0.54_wp, 0.54_wp /) 5948 REAL(wp), PARAMETER ::A_lu(nlu_dep) = & 5949 (/ 3.0_wp, 3.0_wp, 2.0_wp, 2.0_wp, 7.0_wp, -99.0_wp, 10.0_wp, 3.0_wp, -99.0_wp, -99.0_wp, & 5950 3.0_wp, 7.0_wp, -99.0_wp, 2.0_wp, -99.0_wp /) 5951 ! 5952 !-- grass arabl crops conif decid water urba othr desr ice sav trf wai med sem 5953 5953 ! 5954 5954 !-- local 5955 REAL(wp) :: diff_part 5956 REAL(wp) :: ebrown 5957 REAL(wp) :: eimpac 5958 REAL(wp) :: einterc 5955 5959 REAL(wp) :: kinvisc 5956 REAL(wp) :: diff_part5960 REAL(wp) :: reffic 5957 5961 REAL(wp) :: schmidt 5958 5962 REAL(wp) :: stokes 5959 REAL(wp) :: Ebrown 5960 REAL(wp) :: Eimpac 5961 REAL(wp) :: Einterc 5962 REAL(wp) :: Reffic 5963 ! 5964 !-- kinetic viscosity & diffusivity 5963 ! 5964 !-- Kinetic viscosity & diffusivity 5965 5965 kinvisc = viscos1 / dens1 !< only needed at surface 5966 5966 … … 5970 5970 schmidt = kinvisc / diff_part 5971 5971 ! 5972 !-- calculate collection efficiencie E5972 !-- Calculate collection efficiencie E 5973 5973 Ebrown = Schmidt**( -gamma_lu(luc) ) !< Brownian diffusion 5974 5974 ! 5975 !-- determine Stokes number, interception efficiency5976 !-- and sticking efficiency R (1 = no rebound) 5977 IF ( luc == ilu_ice .OR. nwet==9 .OR. luc == ilu_water_sea .OR.luc == ilu_water_inland ) THEN5975 !-- Determine Stokes number, interception efficiency and sticking efficiency R (1 = no rebound) 5976 IF ( luc == ilu_ice .OR. nwet == 9 .OR. luc == ilu_water_sea .OR. & 5977 luc == ilu_water_inland ) THEN 5978 5978 stokes = vs1 * ustar**2 / ( grav * kinvisc ) 5979 Einterc = 0.0_wp5980 Reffic = 1.0_wp5981 ELSE IF ( luc == ilu_other .OR.luc == ilu_desert ) THEN !<tundra of desert5979 einterc = 0.0_wp 5980 reffic = 1.0_wp 5981 ELSE IF ( luc == ilu_other .OR. luc == ilu_desert ) THEN !<tundra of desert 5982 5982 stokes = vs1 * ustar**2 / ( grav * kinvisc ) 5983 Einterc = 0.0_wp5984 Reffic = exp( -Stokes**0.5_wp )5983 einterc = 0.0_wp 5984 reffic = EXP( - stokes**0.5_wp ) 5985 5985 ELSE 5986 stokes = vs1 * ustar / ( grav * A_lu(luc) * 1.0E-3_wp )5987 Einterc = 0.5_wp * ( partsize / (A_lu(luc) * 1.0E-3_wp ) )**25988 Reffic = exp( -Stokes**0.5_wp )5986 stokes = vs1 * ustar / ( grav * a_lu(luc) * 1.0E-3_wp ) 5987 einterc = 0.5_wp * ( partsize / ( a_lu(luc) * 1.0E-3_wp ) )**2 5988 reffic = EXP( - stokes**0.5_wp ) 5989 5989 END IF 5990 5990 ! 5991 !-- when surface is wet all particles do not rebound:5992 IF ( nwet ==1 ) Reffic = 1.0_wp5993 ! 5994 !-- determine impaction efficiency:5995 Eimpac = ( stokes / ( alfa_lu(luc) + stokes ) )**25996 ! 5997 !-- sedimentation resistance:5998 rs = 1.0_wp / ( epsilon0 * MAX( 1.0E-5_wp, ustar ) * ( Ebrown + Eimpac + Einterc ) * Reffic )5999 6000 !-- deposition velocity according to Seinfeld and Pandis (2006; eq 19.7):6001 !-- 5991 !-- When surface is wet all particles do not rebound: 5992 IF ( nwet == 1 ) reffic = 1.0_wp 5993 ! 5994 !-- Determine impaction efficiency: 5995 eimpac = ( stokes / ( alfa_lu(luc) + stokes ) )**2 5996 ! 5997 !-- Sedimentation resistance: 5998 rs = 1.0_wp / ( epsilon0 * MAX( 1.0E-5_wp, ustar ) * ( ebrown + eimpac + einterc ) * reffic ) 5999 6000 !-- Deposition velocity according to Seinfeld and Pandis (2006; eq 19.7): 6001 !-- 6002 6002 !-- 1 6003 6003 !-- vd = ------------------ + vs 6004 6004 !-- Ra + Rs + Ra*Rs*vs 6005 !-- 6005 !-- 6006 6006 !-- where: Rs = Rb (in Seinfeld and Pandis, 2006) 6007 6007 … … 6012 6012 6013 6013 6014 !------------------------------------------------------------------------------------- 6014 !-------------------------------------------------------------------------------------------------! 6015 6015 !> Compute quasi-laminar boundary layer resistance as a function of landuse and tracer 6016 !> Original EMEP formulation by (Simpson et al, 2003) is used 6017 !------------------------------------------------------------------------------------- 6018 SUBROUTINE get_rb_cell( is_water, z0h, ustar, diffusivity, rb ) 6019 6020 ! 6021 !-- in/out 6022 6016 !> Original EMEP formulation by (Simpson et al, 2003) is used. 6017 !-------------------------------------------------------------------------------------------------! 6018 SUBROUTINE get_rb_cell( is_water, z0h, ustar, diffusivity, rb ) 6019 6020 ! 6021 !-- in/out 6023 6022 LOGICAL , INTENT(IN) :: is_water 6024 6023 6024 REAL(wp), INTENT(IN) :: diffusivity !< coefficient of diffusivity 6025 REAL(wp), INTENT(IN) :: ustar !< friction velocity 6025 6026 REAL(wp), INTENT(IN) :: z0h !< roughness length for heat 6026 REAL(wp), INTENT(IN) :: ustar !< friction velocity6027 REAL(wp), INTENT(IN) :: diffusivity !< coefficient of diffusivity6028 6027 6029 6028 REAL(wp), INTENT(OUT) :: rb !< boundary layer resistance … … 6031 6030 !-- const 6032 6031 6032 REAL(wp), PARAMETER :: kappa_stab = 0.35 !< von Karman constant 6033 6033 REAL(wp), PARAMETER :: thk = 0.19e-4 !< thermal diffusivity of dry air 20 C 6034 REAL(wp), PARAMETER :: kappa_stab = 0.35 !< von Karman constant6035 6034 ! 6036 6035 !-- Next line is to avoid compiler warning about unused variable 6037 6036 IF ( is_water .OR. ( z0h + kappa_stab ) > 0.0_wp ) CONTINUE 6038 6037 ! 6039 !-- Use Simpson et al. (2003) 6038 !-- Use Simpson et al. (2003) 6040 6039 !-- @TODO: Check rb over water calculation, until then leave commented lines 6041 6040 !-- IF ( is_water ) THEN 6042 !-- org: rb = 1.0_wp / ( kappa_stab*MAX(0.01_wp,ustar)) * log(z0h/diffusivity*kappa_stab*MAX(0.01_wp,ustar))6043 !-- rb = 1.0_wp / ( kappa_stab*MAX(0.1_wp,ustar)) * log(z0h/diffusivity*kappa_stab*MAX(0.1_wp,ustar))6041 !-- org: rb = 1.0_wp / ( kappa_stab * MAX( 0.01_wp, ustar ) ) * LOG( z0h / diffusivity * kappa_stab * MAX( 0.01_wp, ustar ) ) 6042 !-- rb = 1.0_wp / ( kappa_stab * MAX( 0.1_wp, ustar ) ) * LOG( z0h / diffusivity * kappa_stab * MAX( 0.1_wp, ustar ) ) 6044 6043 !-- ELSE 6045 6044 rb = 5.0_wp / MAX( 0.01_wp, ustar ) * ( thk / diffusivity )**0.67_wp … … 6049 6048 6050 6049 6051 !----------------------------------------------------------------- 6052 !> Compute water vapor partial pressure (e_w) 6053 !> given specific humidity Q [(kg water)/(kg air)]. 6054 !> 6055 !> Use that gas law for volume V with temperature T 6056 !> holds for the total mixture as well as the water part: 6057 !> 6058 !> R T / V = p_air / n_air = p_water / n_water 6059 !> 6060 !> thus: 6061 !> 6062 !> p_water = p_air n_water / n_air 6063 !> 6064 !> Use: 6065 !> n_air = m_air / xm_air 6066 !> [kg air] / [(kg air)/(mole air)] 6067 !> and: 6068 !> n_water = m_air * Q / xm_water 6069 !> [kg water] / [(kg water)/(mole water)] 6070 !> thus: 6071 !> p_water = p_air Q / (xm_water/xm_air) 6072 !------------------------------------------------------------------ 6050 !--------------------------------------------------------------------------------------------------! 6051 !> Compute water vapor partial pressure (e_w) given specific humidity Q [(kg water)/(kg air)]. 6052 !> 6053 !> Use that gas law for volume V with temperature T holds for the total mixture as well as the 6054 !> water part: 6055 !> 6056 !> R T / V = p_air / n_air = p_water / n_water 6057 !> 6058 !> thus: 6059 !> 6060 !> p_water = p_air n_water / n_air 6061 !> 6062 !> Use: 6063 !> n_air = m_air / xm_air 6064 !> [kg air] / [(kg air)/(mole air)] 6065 !> and: 6066 !> n_water = m_air * Q / xm_water 6067 !> [kg water] / [(kg water)/(mole water)] 6068 !> thus: 6069 !> p_water = p_air Q / (xm_water/xm_air) 6070 !--------------------------------------------------------------------------------------------------! 6073 6071 6074 6072 ELEMENTAL FUNCTION watervaporpartialpressure( q, p ) RESULT( p_w ) 6075 6073 6076 6074 ! 6077 !-- in/out 6078 6075 !-- in/out 6076 REAL(wp), INTENT(IN) :: p !< air pressure [Pa] 6079 6077 REAL(wp), INTENT(IN) :: q !< specific humidity [(kg water)/(kg air)] 6080 REAL(wp), INTENT(IN) :: p !< air pressure [Pa]6081 6078 6082 6079 REAL(wp) :: p_w !< water vapor partial pressure [Pa] 6083 6080 ! 6084 !-- const 6085 6081 !-- Const 6086 6082 REAL(wp), PARAMETER :: eps = xm_h2o / xm_air !< mole mass ratio ~ 0.622 6087 6083 ! 6088 !-- partial pressure of water vapor:6084 !-- Partial pressure of water vapor: 6089 6085 p_w = p * q / eps 6090 6086 6091 END function watervaporpartialpressure 6092 6093 6094 !------------------------------------------------------------------ 6095 !> Saturation vapor pressure. 6096 !> From (Stull 1988, eq. 7.5.2d): 6097 !> 6098 !> e_sat = p0 exp( 17.67 * (T-273.16) / (T-29.66) ) [Pa] 6099 !> 6100 !> where: 6101 !> p0 = 611.2 [Pa] : reference pressure 6102 !> 6103 !> Arguments: 6104 !> T [K] : air temperature 6105 !> Result: 6106 !> e_sat_w [Pa] : saturation vapor pressure 6107 !> 6108 !> References: 6109 !> Roland B. Stull, 1988 6110 !> An introduction to boundary layer meteorology. 6111 !----------------------------------------------------------------- 6112 6087 END FUNCTION watervaporpartialpressure 6088 6089 6090 !--------------------------------------------------------------------------------------------------! 6091 !> Saturation vapor pressure. 6092 !> From (Stull 1988, eq. 7.5.2d): 6093 !> 6094 !> e_sat = p0 exp( 17.67 * (T-273.16) / (T-29.66) ) [Pa] 6095 !> 6096 !> where: 6097 !> p0 = 611.2 [Pa] : reference pressure 6098 !> 6099 !> Arguments: 6100 !> T [K] : air temperature 6101 !> Result: 6102 !> e_sat_w [Pa] : saturation vapor pressure 6103 !> 6104 !> References: 6105 !> Roland B. Stull, 1988 6106 !> An introduction to boundary layer meteorology. 6107 !--------------------------------------------------------------------------------------------------! 6113 6108 ELEMENTAL FUNCTION saturationvaporpressure( t ) RESULT( e_sat_w ) 6114 6109 6115 6110 ! 6116 6111 !-- in/out 6117 6118 6112 REAL(wp), INTENT(IN) :: t !< temperature [K] 6119 6113 6120 6114 REAL(wp) :: e_sat_w !< saturation vapor pressure [Pa] 6121 6115 ! 6122 !-- const6116 !-- Const 6123 6117 REAL(wp), PARAMETER :: p0 = 611.2 !< base pressure [Pa] 6124 6118 ! 6125 !-- saturation vapor pressure:6126 e_sat_w = p0 * exp( 17.67_wp * ( t - 273.16_wp ) / ( t - 29.66_wp ) ) !< [Pa]6119 !-- Saturation vapor pressure: 6120 e_sat_w = p0 * EXP( 17.67_wp * ( t - 273.16_wp ) / ( t - 29.66_wp ) ) !< [Pa] 6127 6121 6128 6122 END FUNCTION saturationvaporpressure 6129 6123 6130 6124 6131 !------------------------------------------------------------------------ 6132 6133 6134 6135 6136 6137 !------------------------------------------------------------------------ 6125 !--------------------------------------------------------------------------------------------------! 6126 !> Relative humidity RH [%] is by definition: 6127 !> 6128 !> e_w water vapor partial pressure 6129 !> Rh = -------- * 100 6130 !> e_sat_w saturation vapor pressure 6131 !--------------------------------------------------------------------------------------------------! 6138 6132 6139 6133 ELEMENTAL FUNCTION relativehumidity_from_specifichumidity( q, t, p ) RESULT( rh ) 6140 6134 6141 6135 ! 6142 !-- in/out 6143 6136 !-- in/out 6137 REAL(wp), INTENT(IN) :: p !< air pressure [Pa] 6144 6138 REAL(wp), INTENT(IN) :: q !< specific humidity [(kg water)/(kg air)] 6145 6139 REAL(wp), INTENT(IN) :: t !< temperature [K] 6146 REAL(wp), INTENT(IN) :: p !< air pressure [Pa]6147 6140 6148 6141 REAL(wp) :: rh !< relative humidity [%] 6149 6142 ! 6150 !-- relative humidity:6143 !-- Relative humidity: 6151 6144 rh = watervaporpartialpressure( q, p ) / saturationvaporpressure( t ) * 100.0_wp 6152 6145 6153 6146 END FUNCTION relativehumidity_from_specifichumidity 6154 6147 6155 6148 6156 6149 END MODULE chemistry_model_mod
Note: See TracChangeset
for help on using the changeset viewer.