Changeset 4559 for palm/trunk/SOURCE/chem_emissions_mod.f90
- Timestamp:
- Jun 11, 2020 8:51:48 AM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/chem_emissions_mod.f90 (modified) (106 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/chem_emissions_mod.f90
r4481 r4559 1 1 !> @file chem_emissions_mod.f90 2 !-------------------------------------------------------------------------------- !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of 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 2018-2020 Leibniz Universitaet Hannover 18 17 ! Copyright 2018-2020 Freie Universitaet Berlin 19 18 ! Copyright 2018-2020 Karlsruhe Institute of Technology 20 !-------------------------------------------------------------------------------- !19 !--------------------------------------------------------------------------------------------------! 21 20 ! 22 21 ! Current revisions: 23 22 ! ------------------ 24 ! 23 ! 25 24 ! 26 25 ! Former revisions: 27 26 ! ----------------- 28 27 ! $Id$ 28 ! file re-formatted to follow the PALM coding standard 29 ! 30 ! 4481 2020-03-31 18:55:54Z maronga 29 31 ! Implemented on-demand read mode for LOD 2 (ECC) 30 32 ! - added following module global variables … … 55 57 ! 56 58 ! 4242 2019-09-27 12:59:10Z suehring 57 ! Adjust index_hh access to new definition accompanied with new 59 ! Adjust index_hh access to new definition accompanied with new 58 60 ! palm_date_time_mod. Note, this is just a preleminary fix. (E Chan) 59 ! 61 ! 60 62 ! 4230 2019-09-11 13:58:14Z suehring 61 ! Bugfix, consider that time_since_reference_point can be also negative when 63 ! Bugfix, consider that time_since_reference_point can be also negative when 62 64 ! time indices are determined. 63 ! 65 ! 64 66 ! 4227 2019-09-10 18:04:34Z gronemeier 65 67 ! implement new palm_date_time_mod 66 ! 68 ! 67 69 ! 4223 2019-09-10 09:20:47Z gronemeier 68 70 ! Unused routine chem_emissions_check_parameters commented out due to uninitialized content 69 ! 71 ! 70 72 ! 4182 2019-08-22 15:20:23Z scharf 71 73 ! Corrected "Former revisions" section 72 ! 74 ! 73 75 ! 4157 2019-08-14 09:19:12Z suehring 74 76 ! Replace global arrays also in mode_emis branch 75 ! 77 ! 76 78 ! 4154 2019-08-13 13:35:59Z suehring 77 79 ! Replace global arrays for emissions by local ones. 78 ! 80 ! 79 81 ! 4144 2019-08-06 09:11:47Z raasch 80 82 ! relational operators .EQ., .NE., etc. replaced by ==, /=, etc. 81 ! 83 ! 82 84 ! 4055 2019-06-27 09:47:29Z suehring 83 ! - replaced local thermo. constants w/ module definitions in 84 ! basic_constants_and_equations_mod (rgas_univ, p_0, r_d_cp)85 ! - replaced local thermo. constants w/ module definitions in basic_constants_and_equations_mod 86 ! (rgas_univ, p_0, r_d_cp) 85 87 ! - initialize array emis_distribution immediately following allocation 86 ! - lots of minor formatting changes based on review sesson in 20190325 87 ! (E.C. Chan) 88 ! 88 ! - lots of minor formatting changes based on review sesson in 20190325 (E.C. Chan) 89 ! 89 90 ! 3968 2019-05-13 11:04:01Z suehring 90 ! - in subroutine chem_emissions_match replace all decision structures relating to 91 ! mode_emis toemiss_lod91 ! - in subroutine chem_emissions_match replace all decision structures relating to mode_emis to 92 ! emiss_lod 92 93 ! - in subroutine chem_check_parameters replace emt%nspec with emt%n_emiss_species 93 94 ! - spring cleaning (E.C. Chan) 94 ! 95 ! 95 96 ! 3885 2019-04-11 11:29:34Z kanani 96 ! Changes related to global restructuring of location messages and introduction 97 ! of additional debugmessages98 ! 97 ! Changes related to global restructuring of location messages and introduction of additional debug 98 ! messages 99 ! 99 100 ! 3831 2019-03-28 09:11:22Z forkel 100 ! added nvar to USE chem_gasphase_mod (chem_modules will not include nvar anymore) 101 ! 101 ! added nvar to USE chem_gasphase_mod (chem_modules will not include nvar anymore) 102 ! 102 103 ! 3788 2019-03-07 11:40:09Z banzhafs 103 104 ! Removed unused variables from chem_emissions_mod 104 ! 105 ! 3772 2019-02-28 15:51:57Z suehring 106 ! - In case of parametrized emissions, assure that emissions are only on natural 107 ! surfaces (i.e. streets) and not on urban surfaces.105 ! 106 ! 3772 2019-02-28 15:51:57Z suehring 107 ! - In case of parametrized emissions, assure that emissions are only on natural surfaces 108 ! (i.e. streets) and not on urban surfaces. 108 109 ! - some unnecessary if clauses removed 109 110 ! … … 117 118 ! @author Sabine Banzhaf (FU-Berlin) 118 119 ! @author Martijn Schaap (FU-Berlin, TNO Utrecht) 119 ! 120 ! 120 121 ! Description: 121 122 ! ------------ … … 131 132 !> @note <Enter notes on the module> 132 133 !> @bug <Enter known bugs here> 133 !------------------------------------------------------------------------------ !134 !--------------------------------------------------------------------------------------------------! 134 135 135 136 MODULE chem_emissions_mod 136 137 137 USE arrays_3d, &138 USE arrays_3d, & 138 139 ONLY: rho_air 139 140 140 USE basic_constants_and_equations_mod, & 141 ONLY: rgas_univ, p_0, rd_d_cp 142 143 USE control_parameters, & 144 ONLY: debug_output, & 145 end_time, message_string, initializing_actions, & 146 intermediate_timestep_count, dt_3d 147 141 USE basic_constants_and_equations_mod, & 142 ONLY: p_0, rd_d_cp, rgas_univ 143 144 USE control_parameters, & 145 ONLY: debug_output, end_time, initializing_actions, intermediate_timestep_count, & 146 message_string, dt_3d 147 148 148 USE indices 149 149 … … 154 154 #endif 155 155 156 USE netcdf_data_input_mod, &156 USE netcdf_data_input_mod, & 157 157 ONLY: chem_emis_att_type, chem_emis_val_type 158 158 159 USE chem_gasphase_mod, &159 USE chem_gasphase_mod, & 160 160 ONLY: nvar, spc_names 161 161 162 162 USE chem_modules 163 163 164 USE statistics, &164 USE statistics, & 165 165 ONLY: weight_pres 166 166 … … 169 169 !-- Added new palm_date_time_mod for on-demand emission reading 170 170 171 USE palm_date_time_mod, &171 USE palm_date_time_mod, & 172 172 ONLY: get_date_time 173 173 … … 175 175 176 176 ! 177 !-- Declare all global variables within the module 177 !-- Declare all global variables within the module 178 178 179 179 ! 180 180 !-- 20200203 (ECC) - variable unused 181 ! CHARACTER (LEN=80) :: filename_emis 181 ! CHARACTER (LEN=80) :: filename_emis !< Variable for the name of the netcdf input file 182 182 183 183 ! 184 184 !-- 20200203 (ECC) new variables for on-demand read mode 185 185 186 CHARACTER(LEN=512), ALLOCATABLE, DIMENSION(:) :: timestamps !< timestamps in chemistry file187 188 186 CHARACTER(LEN=*), PARAMETER :: input_file_chem = 'PIDS_CHEM' !< chemistry file 189 187 190 INTEGER(iwp) :: dt_emis !< Time Step Emissions 188 CHARACTER(LEN=512), ALLOCATABLE, DIMENSION(:) :: timestamps !< timestamps in chemistry file 189 190 191 INTEGER(iwp) :: dt_emis !< Time Step Emissions 191 192 INTEGER(iwp) :: i !< index 1st selected dimension (some dims are not spatial) 192 INTEGER(iwp) :: j !< index 2nd selected dimension 193 INTEGER(iwp) :: j !< index 2nd selected dimension 194 INTEGER(iwp) :: i_end !< Index to end read variable from netcdf in one dims 193 195 INTEGER(iwp) :: i_start !< Index to start read variable from netcdf along one dims 194 INTEGER(iwp) :: i_end !< Index to end read variable from netcdf in onedims196 INTEGER(iwp) :: j_end !< Index to end read variable from netcdf in additional dims 195 197 INTEGER(iwp) :: j_start !< Index to start read variable from netcdf in additional dims 196 INTEGER(iwp) :: j_end !< Index to end read variable from netcdf in additional dims197 198 INTEGER(iwp) :: len_index !< length of index (used for several indices) 198 199 INTEGER(iwp) :: len_index_pm !< length of PMs index 199 200 INTEGER(iwp) :: len_index_voc !< length of voc index 200 201 INTEGER(iwp) :: previous_timestamp_index !< index for current timestamp (20200203 ECC) 202 INTEGER(iwp) :: z_end !< Index to end read variable from netcdf in additional dims 201 203 INTEGER(iwp) :: z_start !< Index to start read variable from netcdf in additional dims 202 INTEGER(iwp) :: z_end !< Index to end read variable from netcdf in additional dims203 204 204 205 REAL(wp) :: conversion_factor !< Units Conversion Factor … … 212 213 ! END INTERFACE chem_emissions_check_parameters 213 214 ! 214 !-- Matching Emissions actions 215 !-- Matching Emissions actions 215 216 INTERFACE chem_emissions_match 216 217 MODULE PROCEDURE chem_emissions_match 217 218 END INTERFACE chem_emissions_match 218 219 ! 219 !-- Initialization actions 220 !-- Initialization actions 220 221 INTERFACE chem_emissions_init 221 222 MODULE PROCEDURE chem_emissions_init … … 231 232 232 233 ! 233 !-- initialization actions for on-demand mode 234 !-- initialization actions for on-demand mode 234 235 INTERFACE chem_emissions_header_init 235 236 MODULE PROCEDURE chem_emissions_header_init … … 246 247 ! PUBLIC chem_emissions_init, chem_emissions_match, chem_emissions_setup 247 248 248 PUBLIC chem_emissions_init, chem_emissions_match, chem_emissions_setup, &249 PUBLIC chem_emissions_init, chem_emissions_match, chem_emissions_setup, & 249 250 chem_emissions_header_init, chem_emissions_update_on_demand 250 251 ! … … 254 255 CONTAINS 255 256 256 ! !------------------------------------------------------------------------------ !257 ! !------------------------------------------------------------------------------------------------! 257 258 ! ! Description: 258 259 ! ! ------------ 259 260 ! !> Routine for checking input parameters 260 ! !------------------------------------------------------------------------------ !261 ! !------------------------------------------------------------------------------------------------! 261 262 ! SUBROUTINE chem_emissions_check_parameters 262 263 ! … … 281 282 282 283 283 !------------------------------------------------------------------------------ !284 !--------------------------------------------------------------------------------------------------! 284 285 ! Description: 285 286 ! ------------ 286 !> Matching the chemical species indices. The routine checks what are the 287 !> indices of the emission input species and the corresponding ones of the 288 !> model species. The routine gives as output a vector containing the number 289 !> of common species: it is important to note that while the model species 290 !> are distinct, their values could be given to a single species in input. 291 !> For example, in the case of NO2 and NO, values may be passed in input as 292 !> NOX values. 293 !------------------------------------------------------------------------------! 294 295 SUBROUTINE chem_emissions_match( emt_att,len_index ) 296 297 INTEGER(iwp) :: ind_inp !< Parameters for cycling through chemical input species 298 INTEGER(iwp) :: ind_mod !< Parameters for cycling through chemical model species 287 !> Matching the chemical species indices. The routine checks what are the indices of the emission 288 !> input species and the corresponding ones of the model species. The routine gives as output a 289 !> vector containing the number of common species: it is important to note that while the model 290 !> species are distinct, their values could be given to a single species in input. 291 !> For example, in the case of NO2 and NO, values may be passed in input as NOX values. 292 !--------------------------------------------------------------------------------------------------! 293 294 SUBROUTINE chem_emissions_match( emt_att,len_index ) 295 296 INTEGER(iwp) :: ind_inp !< Parameters for cycling through chemical input species 297 INTEGER(iwp) :: ind_mod !< Parameters for cycling through chemical model species 299 298 INTEGER(iwp) :: ind_voc !< Indices to check whether a split for voc should be done 300 299 INTEGER(iwp) :: ispec !< index for cycle over effective number of emission species … … 312 311 313 312 nspec_emis_inp = emt_att%n_emiss_species 314 ! nspec_emis_inp=emt_att%nspec 313 ! nspec_emis_inp=emt_att%nspec 315 314 316 315 ! 317 316 !-- Check the emission LOD: 0 (PARAMETERIZED), 1 (DEFAULT), 2 (PRE-PROCESSED) 318 !319 317 SELECT CASE (emiss_lod) 320 318 321 319 ! 322 !-- LOD 0 (PARAMETERIZED mode) 323 320 !-- LOD 0 (PARAMETERIZED mode) 324 321 CASE (0) 325 322 326 323 len_index = 0 327 328 ! number of species and number of matched species can be different 329 ! but call is only made if both are greater than zero 330 324 ! 325 !-- Number of species and number of matched species can be different but call is only made if 326 !-- both are greater than zero. 331 327 IF ( nvar > 0 .AND. nspec_emis_inp > 0 ) THEN 332 328 333 329 ! 334 !-- Cycle over model species 335 330 !-- Cycle over model species 336 331 DO ind_mod = 1, nvar 337 332 ind_inp = 1 338 DO WHILE ( TRIM( surface_csflux_name(ind_inp) ) /= 'novalue' ) !< 'novalue' is the default 333 DO WHILE ( TRIM( surface_csflux_name(ind_inp) ) /= 'novalue' ) !< 'novalue' is the default 339 334 IF ( TRIM( surface_csflux_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) ) THEN 340 335 len_index = len_index + 1 … … 347 342 348 343 ! 349 !-- Allocation of Arrays of the matched species 350 351 ALLOCATE ( match_spec_input(len_index) ) 344 !-- Allocation of Arrays of the matched species 345 ALLOCATE ( match_spec_input(len_index) ) 352 346 ALLOCATE ( match_spec_model(len_index) ) 353 347 354 348 ! 355 !-- Pass species indices to declared arrays 356 349 !-- Pass species indices to declared arrays 357 350 len_index = 0 358 351 359 DO ind_mod = 1, nvar 352 DO ind_mod = 1, nvar 360 353 ind_inp = 1 361 354 DO WHILE ( TRIM( surface_csflux_name(ind_inp) ) /= 'novalue' ) 362 IF ( TRIM( surface_csflux_name(ind_inp)) ==&363 TRIM(spc_names(ind_mod)) )THEN355 IF ( TRIM( surface_csflux_name(ind_inp) ) == TRIM(spc_names(ind_mod) ) ) & 356 THEN 364 357 len_index = len_index + 1 365 358 match_spec_input(len_index) = ind_inp … … 371 364 372 365 ! 373 !-- Check 374 366 !-- Check 375 367 DO ispec = 1, len_index 376 368 377 IF ( emiss_factor_main(match_spec_input(ispec) ) < 0 .AND. &369 IF ( emiss_factor_main(match_spec_input(ispec) ) < 0 .AND. & 378 370 emiss_factor_side(match_spec_input(ispec) ) < 0 ) THEN 379 371 380 message_string = 'PARAMETERIZED emissions mode selected:' // 381 ' EMISSIONS POSSIBLE ONLY ON STREET SURFACES' // 382 ' but values of scaling factors for street types' // 383 ' emiss_factor_main AND emiss_factor_side' // 384 ' not provided for each of the emissions species' // 385 ' or not provided at all: PLEASE set a finite value' // 386 ' for these parameters in the chemistry namelist' 372 message_string = 'PARAMETERIZED emissions mode selected:' // & 373 ' EMISSIONS POSSIBLE ONLY ON STREET SURFACES' // & 374 ' but values of scaling factors for street types' // & 375 ' emiss_factor_main AND emiss_factor_side' // & 376 ' not provided for each of the emissions species' // & 377 ' or not provided at all: PLEASE set a finite value' // & 378 ' for these parameters in the chemistry namelist' 387 379 CALL message( 'chem_emissions_matching', 'CM0442', 2, 2, 0, 6, 0 ) 388 380 389 381 ENDIF 390 382 … … 393 385 394 386 ELSE 395 396 message_string = 'Non of given Emission Species' // &397 ' matches' // &398 ' model chemical species' // &399 ' Emission routine is not called' 387 388 message_string = 'Non of given Emission Species' // & 389 ' matches' // & 390 ' model chemical species' // & 391 ' Emission routine is not called' 400 392 CALL message( 'chem_emissions_matching', 'CM0443', 0, 0, 0, 6, 0 ) 401 393 402 394 ENDIF 403 395 404 396 ELSE 405 406 message_string = 'Array of Emission species not allocated: ' // &407 ' Either no emission species are provided as input or' // &408 ' no chemical species are used by PALM.' // &409 ' Emission routine is not called' 410 CALL message( 'chem_emissions_matching', 'CM0444', 0, 2, 0, 6, 0 ) 411 397 398 message_string = 'Array of Emission species not allocated: ' // & 399 ' Either no emission species are provided as input or' // & 400 ' no chemical species are used by PALM.' // & 401 ' Emission routine is not called' 402 CALL message( 'chem_emissions_matching', 'CM0444', 0, 2, 0, 6, 0 ) 403 412 404 ENDIF 413 405 414 406 ! 415 !-- LOD 1 (DEFAULT mode) 416 407 !-- LOD 1 (DEFAULT mode) 417 408 CASE (1) 418 409 419 len_index = 0 ! total number of species (to be accumulated) 410 len_index = 0 ! total number of species (to be accumulated) 420 411 len_index_voc = 0 ! total number of VOCs (to be accumulated) 421 412 len_index_pm = 3 ! total number of PMs: PM1, PM2.5, PM10. 422 413 423 414 ! 424 !-- number of model species and input species could be different 425 !-- but process this only when both are non-zero 426 415 !-- Number of model species and input species could be different but process this only when both are 416 !-- non-zero 427 417 IF ( nvar > 0 .AND. nspec_emis_inp > 0 ) THEN 428 418 429 419 ! 430 !-- Cycle over model species420 !-- Cycle over model species 431 421 DO ind_mod = 1, nvar 432 422 433 423 ! 434 !-- Cycle over input species 435 424 !-- Cycle over input species 436 425 DO ind_inp = 1, nspec_emis_inp 437 426 438 427 ! 439 !-- Check for VOC Species 440 428 !-- Check for VOC Species 441 429 IF ( TRIM( emt_att%species_name(ind_inp) ) == "VOC" ) THEN 442 430 DO ind_voc= 1, emt_att%nvoc 443 444 IF ( TRIM( emt_att%voc_name(ind_voc) ) == TRIM( spc_names(ind_mod) ) ) THEN 431 432 IF ( TRIM( emt_att%voc_name(ind_voc) ) == TRIM( spc_names(ind_mod) ) ) & 433 THEN 445 434 len_index = len_index + 1 446 435 len_index_voc = len_index_voc + 1 447 436 ENDIF 448 437 449 438 END DO 450 439 ENDIF 451 440 452 441 ! 453 !-- PMs: There is one input species name for all PM 454 !-- This variable has 3 dimensions, one for PM1, PM2.5 and PM10 455 442 !-- PMs: There is one input species name for all PM. This variable has 3 dimensions, one for PM1, 443 !-- PM2.5 and PM10 456 444 IF ( TRIM( emt_att%species_name(ind_inp) ) == "PM" ) THEN 457 445 … … 467 455 468 456 ! 469 !-- NOX: NO2 and NO 470 471 IF ( TRIM( emt_att%species_name(ind_inp) ) == "NOX" ) THEN 457 !-- NOX: NO2 and NO 458 IF ( TRIM( emt_att%species_name(ind_inp) ) == "NOX" ) THEN 472 459 473 460 IF ( TRIM( spc_names(ind_mod) ) == "NO" ) THEN … … 480 467 481 468 ! 482 !-- SOX: SO2 and SO4 483 469 !-- SOX: SO2 and SO4 484 470 IF ( TRIM( emt_att%species_name(ind_inp) ) == "SOX" ) THEN 485 471 … … 493 479 494 480 ! 495 !-- Other Species 496 497 IF ( TRIM( emt_att%species_name(ind_inp) ) == & 498 TRIM( spc_names(ind_mod) ) ) THEN 481 !-- Other Species 482 IF ( TRIM( emt_att%species_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) ) THEN 499 483 len_index = len_index + 1 500 484 ENDIF … … 506 490 507 491 ! 508 !-- Allocate arrays 509 492 !-- Allocate arrays 510 493 IF ( len_index > 0 ) THEN 511 494 … … 514 497 515 498 IF ( len_index_voc > 0 ) THEN 516 517 ! 518 !-- Contains indices of the VOC model species 519 499 ! 500 !-- Contains indices of the VOC model species 520 501 ALLOCATE( match_spec_voc_model(len_index_voc) ) 521 522 ! 523 !-- Contains the indices of different values of VOC composition 524 !-- of input variable VOC_composition 525 502 ! 503 !-- Contains the indices of different values of VOC composition of input variable 504 !-- VOC_composition 526 505 ALLOCATE( match_spec_voc_input(len_index_voc) ) 527 506 … … 529 508 530 509 ! 531 !-- Pass the species indices to declared arrays 532 510 !-- Pass the species indices to declared arrays 533 511 len_index = 0 534 512 len_index_voc = 0 535 513 536 514 DO ind_mod = 1, nvar 537 DO ind_inp = 1, nspec_emis_inp 538 539 ! 540 !-- VOCs 541 542 IF ( TRIM( emt_att%species_name(ind_inp) ) == "VOC" .AND. & 543 ALLOCATED (match_spec_voc_input) ) THEN 515 DO ind_inp = 1, nspec_emis_inp 516 517 ! 518 !-- VOCs 519 IF ( TRIM( emt_att%species_name(ind_inp) ) == "VOC" .AND. & 520 ALLOCATED( match_spec_voc_input ) ) THEN 544 521 545 522 DO ind_voc = 1, emt_att%nvoc 546 523 547 IF ( TRIM( emt_att%voc_name(ind_voc) ) == 548 TRIM( spc_names(ind_mod) ) )THEN524 IF ( TRIM( emt_att%voc_name(ind_voc) ) == TRIM( spc_names(ind_mod) ) )& 525 THEN 549 526 550 527 len_index = len_index + 1 551 528 len_index_voc = len_index_voc + 1 552 529 553 530 match_spec_input(len_index) = ind_inp 554 531 match_spec_model(len_index) = ind_mod … … 564 541 565 542 ! 566 !-- PMs 567 543 !-- PMs 568 544 IF ( TRIM( emt_att%species_name(ind_inp) ) == "PM" ) THEN 569 545 … … 585 561 586 562 ! 587 !-- NOX563 !-- NOX 588 564 IF ( TRIM( emt_att%species_name(ind_inp) ) == "NOX" ) THEN 589 565 … … 599 575 match_spec_input(len_index) = ind_inp 600 576 match_spec_model(len_index) = ind_mod 601 577 602 578 ENDIF 603 579 … … 606 582 607 583 ! 608 !-- SOX 609 584 !-- SOX 610 585 IF ( TRIM( emt_att%species_name(ind_inp) ) == "SOX" ) THEN 611 586 … … 623 598 624 599 ! 625 !-- Other Species626 627 IF ( TRIM( emt_att%species_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) )THEN600 !-- Other Species 601 IF ( TRIM( emt_att%species_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) ) & 602 THEN 628 603 len_index = len_index + 1 629 604 match_spec_input(len_index) = ind_inp … … 636 611 637 612 ! 638 !-- Error reporting (no matching) 639 613 !-- Error reporting (no matching) 640 614 ELSE 641 615 642 message_string = 'None of given Emission Species matches' // &643 ' model chemical species' // &644 ' Emission routine is not called' 645 CALL message( 'chem_emissions_matching', 'CM0440', 0, 0, 0, 6, 0 ) 616 message_string = 'None of given Emission Species matches' // & 617 ' model chemical species' // & 618 ' Emission routine is not called' 619 CALL message( 'chem_emissions_matching', 'CM0440', 0, 0, 0, 6, 0 ) 646 620 647 621 ENDIF 648 622 649 623 ! 650 !-- Error reporting (no species) 651 624 !-- Error reporting (no species) 652 625 ELSE 653 626 654 message_string = 'Array of Emission species not allocated: ' // &655 ' Either no emission species are provided as input or' // &656 ' no chemical species are used by PALM:' // &657 ' Emission routine is not called' 658 CALL message( 'chem_emissions_matching', 'CM0441', 0, 2, 0, 6, 0 ) 659 627 message_string = 'Array of Emission species not allocated: ' // & 628 ' Either no emission species are provided as input or' // & 629 ' no chemical species are used by PALM:' // & 630 ' Emission routine is not called' 631 CALL message( 'chem_emissions_matching', 'CM0441', 0, 2, 0, 6, 0 ) 632 660 633 ENDIF 661 634 662 635 ! 663 !-- LOD 2 (PRE-PROCESSED mode) 664 636 !-- LOD 2 (PRE-PROCESSED mode) 665 637 CASE (2) 666 638 … … 670 642 IF ( nvar > 0 .AND. nspec_emis_inp > 0 ) THEN 671 643 ! 672 !-- Cycle over model species673 DO ind_mod = 1, nvar 674 675 ! 676 !-- Cycle over input species644 !-- Cycle over model species 645 DO ind_mod = 1, nvar 646 647 ! 648 !-- Cycle over input species 677 649 DO ind_inp = 1, nspec_emis_inp 678 650 679 651 ! 680 !-- Check for VOC Species 681 682 IF ( TRIM( emt_att%species_name(ind_inp) ) == "VOC" ) THEN 652 !-- Check for VOC Species 653 IF ( TRIM( emt_att%species_name(ind_inp) ) == "VOC" ) THEN 683 654 DO ind_voc = 1, emt_att%nvoc 684 IF ( TRIM( emt_att%voc_name(ind_voc) ) == TRIM( spc_names(ind_mod) ) ) THEN 655 IF ( TRIM( emt_att%voc_name(ind_voc) ) == TRIM( spc_names(ind_mod) ) ) & 656 THEN 685 657 len_index = len_index + 1 686 658 len_index_voc = len_index_voc + 1 … … 690 662 691 663 ! 692 !-- Other Species 693 694 IF ( TRIM(emt_att%species_name(ind_inp)) == TRIM(spc_names(ind_mod)) ) THEN 664 !-- Other Species 665 IF ( TRIM( emt_att%species_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) ) THEN 695 666 len_index = len_index + 1 696 667 ENDIF … … 699 670 700 671 ! 701 !-- Allocate array for storing the indices of the matched species 702 672 !-- Allocate array for storing the indices of the matched species 703 673 IF ( len_index > 0 ) THEN 704 705 ALLOCATE ( match_spec_input(len_index) ) 706 674 675 ALLOCATE ( match_spec_input(len_index) ) 676 707 677 ALLOCATE ( match_spec_model(len_index) ) 708 678 709 679 IF ( len_index_voc > 0 ) THEN 710 680 ! 711 !-- contains indices of the VOC model species681 !-- Contains indices of the VOC model species 712 682 ALLOCATE( match_spec_voc_model(len_index_voc) ) 713 683 ! 714 !-- contains the indices of different values of VOC composition of input variable VOC_composition 684 !-- Contains the indices of different values of VOC composition of input variable 685 !-- VOC_composition 715 686 ALLOCATE( match_spec_voc_input(len_index_voc) ) 716 687 … … 718 689 719 690 ! 720 !-- pass the species indices to declared arrays 721 691 !-- Pass the species indices to declared arrays 722 692 len_index = 0 723 693 724 694 ! 725 !-- Cycle over model species 726 695 !-- Cycle over model species 727 696 DO ind_mod = 1, nvar 728 729 ! 730 !-- Cycle over Input species 731 697 698 ! 699 !-- Cycle over Input species 732 700 DO ind_inp = 1, nspec_emis_inp 733 701 734 702 ! 735 !-- VOCs 736 737 IF ( TRIM(emt_att%species_name(ind_inp) ) == "VOC" .AND. & 738 ALLOCATED(match_spec_voc_input) ) THEN 739 703 !-- VOCs 704 IF ( TRIM( emt_att%species_name(ind_inp) ) == "VOC" .AND. & 705 ALLOCATED( match_spec_voc_input ) ) THEN 706 740 707 DO ind_voc= 1, emt_att%nvoc 741 IF ( TRIM( emt_att%voc_name(ind_voc) ) == TRIM( spc_names(ind_mod) ) ) THEN 708 IF ( TRIM( emt_att%voc_name(ind_voc) ) == TRIM( spc_names(ind_mod) ) )& 709 THEN 742 710 len_index = len_index + 1 743 711 len_index_voc = len_index_voc + 1 744 712 745 713 match_spec_input(len_index) = ind_inp 746 714 match_spec_model(len_index) = ind_mod 747 715 748 716 match_spec_voc_input(len_index_voc) = ind_voc 749 match_spec_voc_model(len_index_voc) = ind_mod 717 match_spec_voc_model(len_index_voc) = ind_mod 750 718 ENDIF 751 719 END DO … … 753 721 754 722 ! 755 !-- Other Species756 757 IF ( TRIM( emt_att%species_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) )THEN723 !-- Other Species 724 IF ( TRIM( emt_att%species_name(ind_inp) ) == TRIM( spc_names(ind_mod) ) ) & 725 THEN 758 726 len_index = len_index + 1 759 727 match_spec_input(len_index) = ind_inp … … 767 735 768 736 ! 769 !-- in case there are no species matching (just informational message) 770 771 message_string = 'Non of given emission species' // & 772 ' matches' // & 773 ' model chemical species:' // & 774 ' Emission routine is not called' 737 !-- In case there are no species matching (just informational message) 738 message_string = 'Non of given emission species' // & 739 ' matches' // & 740 ' model chemical species:' // & 741 ' Emission routine is not called' 775 742 CALL message( 'chem_emissions_matching', 'CM0438', 0, 0, 0, 6, 0 ) 776 743 ENDIF 777 744 778 745 ! 779 !-- Error check (no matching) 780 746 !-- Error check (no matching) 781 747 ELSE 782 748 783 749 ! 784 !-- either spc_names is zero or nspec_emis_inp is not allocated785 message_string = 'Array of Emission species not allocated:' // &786 ' Either no emission species are provided as input or' // &787 ' no chemical species are used by PALM:' // &788 ' Emission routine is not called' 789 CALL message( 'chem_emissions_matching', 'CM0439', 0, 2, 0, 6, 0 ) 790 791 ENDIF 750 !-- Either spc_names is zero or nspec_emis_inp is not allocated 751 message_string = 'Array of Emission species not allocated:' // & 752 ' Either no emission species are provided as input or' // & 753 ' no chemical species are used by PALM:' // & 754 ' Emission routine is not called' 755 CALL message( 'chem_emissions_matching', 'CM0439', 0, 2, 0, 6, 0 ) 756 757 ENDIF 792 758 793 759 ! … … 795 761 796 762 ! 797 !-- Error check (no species) 798 763 !-- Error check (no species) 799 764 CASE DEFAULT 800 765 801 766 message_string = 'Emission Module switched ON, but' // & 802 767 ' either no emission mode specified or incorrectly given :' // & 803 ' please, pass the correct value to the namelist parameter "mode_emis"' 804 CALL message( 'chem_emissions_matching', 'CM0445', 2, 2, 0, 6, 0 ) 768 ' please, pass the correct value to the namelist parameter "mode_emis"' 769 CALL message( 'chem_emissions_matching', 'CM0445', 2, 2, 0, 6, 0 ) 805 770 806 771 END SELECT … … 810 775 END SUBROUTINE chem_emissions_match 811 776 812 813 !------------------------------------------------------------------------------ !777 778 !--------------------------------------------------------------------------------------------------! 814 779 ! Description: 815 780 ! ------------ 816 781 !> Initialization: 817 !> Netcdf reading, arrays allocation and first calculation of cssws 818 !> fluxes at timestep 0 819 !------------------------------------------------------------------------------! 782 !> Netcdf reading, arrays allocation and first calculation of cssws fluxes at timestep 0 783 !--------------------------------------------------------------------------------------------------! 820 784 821 785 SUBROUTINE chem_emissions_init 822 786 823 USE netcdf_data_input_mod, &787 USE netcdf_data_input_mod, & 824 788 ONLY: chem_emis, chem_emis_att 825 789 826 790 IMPLICIT NONE 827 791 828 792 INTEGER(iwp) :: ispec !< running index 829 793 830 ! 831 !-- Actions for initial runs 794 ! 795 !-- Actions for initial runs 832 796 ! IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN 833 !-- ... 834 ! 797 !-- ... 798 ! 835 799 ! 836 800 !-- Actions for restart runs … … 845 809 ! 846 810 !-- Matching 847 848 811 CALL chem_emissions_match( chem_emis_att, n_matched_vars ) 849 812 850 813 IF ( n_matched_vars == 0 ) THEN 851 814 852 815 emission_output_required = .FALSE. 853 816 … … 858 821 859 822 ! 860 !-- Set molecule masses (in kg/mol) 861 823 !-- Set molecule masses (in kg/mol) 862 824 ALLOCATE( chem_emis_att%xm(n_matched_vars) ) 863 825 … … 878 840 ENDDO 879 841 880 881 ! 882 !-- Get emissions for the first time step base on LOD (if defined) 883 !-- or emission mode (if no LOD defined) 884 885 ! 886 !-- NOTE - I could use a combined if ( lod = xxx .or. mode = 'XXX' ) 887 !-- type of decision structure but I think it is much better 888 !-- to implement it this way (i.e., conditional on lod if it 889 !-- is defined, and mode if not) as we can easily take out 890 !-- the case structure for mode_emis later on. 842 843 ! 844 !-- Get emissions for the first time step base on LOD (if defined) or emission mode 845 !-- (if no LOD defined) 846 847 ! 848 !-- NOTE - I could use a combined if ( lod = xxx .or. mode = 'XXX' ) type of decision structure but 849 ! I think it is much better to implement it this way (i.e., conditional on lod if it is 850 ! defined, and mode if not) as we can easily take out the case structure for mode_emis 851 ! later on. 891 852 892 853 IF ( emiss_lod < 0 ) THEN !-- no LOD defined (not likely) 893 854 894 SELECT CASE ( TRIM( mode_emis ) ) 855 SELECT CASE ( TRIM( mode_emis ) ) 895 856 896 857 CASE ( 'PARAMETERIZED' ) ! LOD 0 897 858 898 IF ( .NOT.ALLOCATED( emis_distribution) ) THEN859 IF ( .NOT. ALLOCATED( emis_distribution) ) THEN 899 860 ALLOCATE( emis_distribution(1,nys:nyn,nxl:nxr,n_matched_vars) ) 900 861 ENDIF … … 904 865 CASE ( 'DEFAULT' ) ! LOD 1 905 866 906 IF ( .NOT.ALLOCATED( emis_distribution) ) THEN867 IF ( .NOT. ALLOCATED( emis_distribution) ) THEN 907 868 ALLOCATE( emis_distribution(1,nys:nyn,nxl:nxr,n_matched_vars) ) 908 869 ENDIF … … 912 873 CASE ( 'PRE-PROCESSED' ) ! LOD 2 913 874 914 IF ( .NOT.ALLOCATED( emis_distribution) ) THEN915 ! 916 !-- Note, at the moment emissions are considered only by surface fluxes 917 !-- rather than by volume sources. Therefore, no vertical dimension is918 !-- required and is thus allocated with 1. Later when volume sources919 !-- are considered, the vertical dimension will increase.875 IF ( .NOT. ALLOCATED( emis_distribution) ) THEN 876 ! 877 !-- Note, at the moment emissions are considered only by surface fluxes rather than 878 !-- by volume sources. Therefore, no vertical dimension is required and is thus 879 !-- allocated with 1. Later when volume sources are considered, the vertical 880 !-- dimension will increase. 920 881 !ALLOCATE( emis_distribution(nzb:nzt+1,nys:nyn,nxl:nxr,n_matched_vars) ) 921 882 ALLOCATE( emis_distribution(1,nys:nyn,nxl:nxr,n_matched_vars) ) 922 883 ENDIF 923 884 924 885 CALL chem_emissions_setup( chem_emis_att, chem_emis, n_matched_vars ) 925 886 … … 932 893 CASE ( 0 ) ! parameterized mode 933 894 934 IF ( .NOT.ALLOCATED( emis_distribution) ) THEN895 IF ( .NOT. ALLOCATED( emis_distribution) ) THEN 935 896 ALLOCATE( emis_distribution(1,nys:nyn,nxl:nxr,n_matched_vars) ) 936 897 ENDIF … … 940 901 CASE ( 1 ) ! default mode 941 902 942 IF ( .NOT.ALLOCATED( emis_distribution) ) THEN903 IF ( .NOT. ALLOCATED( emis_distribution) ) THEN 943 904 ALLOCATE( emis_distribution(1,nys:nyn,nxl:nxr,n_matched_vars) ) 944 905 ENDIF … … 948 909 CASE ( 2 ) ! pre-processed mode 949 910 950 IF ( .NOT.ALLOCATED( emis_distribution) ) THEN911 IF ( .NOT. ALLOCATED( emis_distribution) ) THEN 951 912 ALLOCATE( emis_distribution(nzb:nzt+1,nys:nyn,nxl:nxr,n_matched_vars) ) 952 913 ENDIF 953 914 954 915 CALL chem_emissions_setup( chem_emis_att, chem_emis, n_matched_vars ) 955 916 … … 959 920 960 921 ! 961 ! -- initialize 962 922 ! -- Initialize 963 923 emis_distribution = 0.0_wp 964 924 … … 971 931 972 932 973 !------------------------------------------------------------------------------ !933 !--------------------------------------------------------------------------------------------------! 974 934 ! Description: 975 935 ! ------------ 976 936 !> Routine for Update of Emission values at each timestep. 977 937 !> 978 !> @todo Clarify the correct usage of index_dd, index_hh and index_mm. Consider 979 !> renaming of thesevariables.938 !> @todo Clarify the correct usage of index_dd, index_hh and index_mm. Consider renaming of these 939 !> variables. 980 940 !> @todo Clarify time used in emis_lod=2 mode. ATM, the used time seems strange. 981 !------------------------------------------------------------------------------- !941 !--------------------------------------------------------------------------------------------------! 982 942 983 943 SUBROUTINE chem_emissions_setup( emt_att, emt, n_matched_vars ) 984 985 USE surface_mod, &944 945 USE surface_mod, & 986 946 ONLY: surf_def_h, surf_lsm_h, surf_usm_h 987 947 988 USE netcdf_data_input_mod, &948 USE netcdf_data_input_mod, & 989 949 ONLY: street_type_f 990 950 991 USE arrays_3d, &992 ONLY: hyp, pt 993 994 USE control_parameters, &951 USE arrays_3d, & 952 ONLY: hyp, pt 953 954 USE control_parameters, & 995 955 ONLY: time_since_reference_point 996 956 997 USE palm_date_time_mod, &957 USE palm_date_time_mod, & 998 958 ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_day 999 959 1000 960 IMPLICIT NONE 1001 1002 1003 TYPE(chem_emis_att_type), INTENT(INOUT) :: emt_att !< variable to store emission information 1004 1005 TYPE(chem_emis_val_type), INTENT(INOUT), ALLOCATABLE, DIMENSION(:) :: emt !< variable to store emission input values, 961 962 INTEGER(iwp) :: day_of_month !< day of the month 963 INTEGER(iwp) :: day_of_week !< day of the week 964 INTEGER(iwp) :: day_of_year !< day of the year 965 INTEGER(iwp) :: days_since_reference_point !< days since reference point 966 INTEGER(iwp) :: i !< running index for grid in x-direction 967 INTEGER(iwp) :: i_pm_comp !< index for number of PM components 968 INTEGER(iwp) :: icat !< Index for number of categories 969 INTEGER(iwp) :: index_dd !< index day 970 INTEGER(iwp) :: index_hh !< index hour 971 INTEGER(iwp) :: index_mm !< index month 972 INTEGER(iwp) :: ispec !< index for number of species 973 INTEGER(iwp) :: ivoc !< Index for number of VOCs 974 INTEGER(iwp) :: hour_of_day !< hour of the day 975 INTEGER(iwp) :: j !< running index for grid in y-direction 976 INTEGER(iwp) :: k !< running index for grid in z-direction 977 INTEGER(iwp) :: m !< running index for horizontal surfaces 978 INTEGER(iwp) :: month_of_year !< month of the year 979 980 INTEGER,INTENT(IN) :: n_matched_vars !< Output of matching routine with number 981 !< of matched species 982 983 REAL(wp) :: time_utc_init !< second of day of initial date 984 985 TYPE(chem_emis_att_type), INTENT(INOUT) :: emt_att !< variable to store emission information 986 987 TYPE(chem_emis_val_type), INTENT(INOUT), ALLOCATABLE, DIMENSION(:) :: emt !< variable to store emission input values, 1006 988 !< depending on the considered species 1007 1008 INTEGER,INTENT(IN) :: n_matched_vars !< Output of matching routine with number 1009 !< of matched species 1010 1011 INTEGER(iwp) :: i !< running index for grid in x-direction 1012 INTEGER(iwp) :: i_pm_comp !< index for number of PM components 1013 INTEGER(iwp) :: icat !< Index for number of categories 1014 INTEGER(iwp) :: ispec !< index for number of species 1015 INTEGER(iwp) :: ivoc !< Index for number of VOCs 1016 INTEGER(iwp) :: j !< running index for grid in y-direction 1017 INTEGER(iwp) :: k !< running index for grid in z-direction 1018 INTEGER(iwp) :: m !< running index for horizontal surfaces 1019 1020 INTEGER(iwp) :: day_of_month !< day of the month 1021 INTEGER(iwp) :: day_of_week !< day of the week 1022 INTEGER(iwp) :: day_of_year !< day of the year 1023 INTEGER(iwp) :: days_since_reference_point !< days since reference point 1024 INTEGER(iwp) :: hour_of_day !< hour of the day 1025 INTEGER(iwp) :: month_of_year !< month of the year 1026 INTEGER(iwp) :: index_dd !< index day 1027 INTEGER(iwp) :: index_hh !< index hour 1028 INTEGER(iwp) :: index_mm !< index month 1029 1030 REAL(wp) :: time_utc_init !< second of day of initial date 1031 1032 ! 1033 !-- CONVERSION FACTORS: TIME 1034 REAL(wp), PARAMETER :: hour_per_year = 8760.0_wp !< number of hours in a year of 365 days 1035 REAL(wp), PARAMETER :: s_per_hour = 3600.0_wp !< number of sec per hour (s)/(hour) 1036 REAL(wp), PARAMETER :: s_per_day = 86400.0_wp !< number of sec per day (s)/(day) 989 ! 990 !-- CONVERSION FACTORS: TIME 991 REAL(wp), PARAMETER :: hour_per_year = 8760.0_wp !< number of hours in a year of 365 days 992 REAL(wp), PARAMETER :: s_per_hour = 3600.0_wp !< number of sec per hour (s)/(hour) 993 REAL(wp), PARAMETER :: s_per_day = 86400.0_wp !< number of sec per day (s)/(day) 1037 994 1038 995 REAL(wp), PARAMETER :: day_to_s = 1.0_wp/s_per_day !< conversion day -> sec 1039 996 REAL(wp), PARAMETER :: hour_to_s = 1.0_wp/s_per_hour !< conversion hours -> sec 1040 997 REAL(wp), PARAMETER :: year_to_s = 1.0_wp/(s_per_hour*hour_per_year) !< conversion year -> sec 1041 ! 1042 !-- CONVERSION FACTORS: MASS 1043 REAL(wp), PARAMETER :: g_to_kg = 1.0E-03_wp !< Conversion from g to kg (kg/g) 998 999 1000 ! 1001 !-- CONVERSION FACTORS: MASS 1002 REAL(wp), PARAMETER :: g_to_kg = 1.0E-03_wp !< Conversion from g to kg (kg/g) 1044 1003 REAL(wp), PARAMETER :: miug_to_kg = 1.0E-09_wp !< Conversion from g to kg (kg/g) 1045 REAL(wp), PARAMETER :: tons_to_kg = 100.0_wp !< Conversion from tons to kg (kg/tons) 1046 1047 1048 REAL(wp), PARAMETER :: ratio2ppm = 1.0E+06_wp 1049 1004 REAL(wp), PARAMETER :: tons_to_kg = 100.0_wp !< Conversion from tons to kg (kg/tons) 1005 ! 1006 !-- CONVERSION FACTORS: PPM 1007 REAL(wp), PARAMETER :: ratio2ppm = 1.0E+06_wp 1008 1050 1009 REAL(wp), DIMENSION(24) :: par_emis_time_factor !< time factors for the parameterized mode: 1051 1010 !< fixed houlry profile for example day 1052 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: conv_to_ratio !< factor used for converting input 1011 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: conv_to_ratio !< factor used for converting input 1053 1012 !< to concentration ratio 1054 1013 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: tmp_temp !< temporary variable for abs. temperature 1055 1014 1056 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: delta_emis !< incremental emission factor1057 1015 REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< factor for time scaling of emissions 1016 1017 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: delta_emis !< incremental emission factor 1058 1018 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: emis !< emission factor 1059 1019 1020 1060 1021 IF ( emission_output_required ) THEN 1061 1022 1062 1023 ! 1063 !-- Set emis_dt to be used - since chemistry ODEs can be stiff, the option 1064 !-- to solve them at every RK substep is present to help improve stability 1065 !-- should the need arises 1066 1024 !-- Set emis_dt to be used - since chemistry ODEs can be stiff, the option to solve them at every 1025 !-- RK substep is present to help improve stability should the need arises 1026 1067 1027 IF ( call_chem_at_all_substeps ) THEN 1068 1028 … … 1076 1036 1077 1037 ! 1078 !-- Conversion of units to the ones employed in PALM 1079 !-- In PARAMETERIZED mode no conversion is performed: in this case input units are fixed 1080 1038 !-- Conversion of units to the ones employed in PALM 1039 !-- In PARAMETERIZED mode no conversion is performed: in this case input units are fixed 1081 1040 IF ( TRIM( mode_emis ) == "DEFAULT" .OR. TRIM( mode_emis ) == "PRE-PROCESSED" ) THEN 1082 1041 … … 1101 1060 1102 1061 ! 1103 !-- Error check (need units) 1104 1105 CASE DEFAULT 1106 message_string = 'The Units of the provided emission input' // & 1107 ' are not the ones required by PALM-4U: please check ' // & 1108 ' emission module documentation.' 1062 !-- Error check (need units) 1063 CASE DEFAULT 1064 message_string = 'The Units of the provided emission input' // & 1065 ' are not the ones required by PALM-4U: please check ' // & 1066 ' emission module documentation.' 1109 1067 CALL message( 'chem_emissions_setup', 'CM0446', 2, 2, 0, 6, 0 ) 1110 1068 … … 1114 1072 1115 1073 ! 1116 !-- Conversion factor to convert kg/m**2/s to ppm/s 1117 1074 !-- Conversion factor to convert kg/m**2/s to ppm/s 1118 1075 DO i = nxl, nxr 1119 1076 DO j = nys, nyn 1120 1077 1121 1078 ! 1122 !-- Derive Temperature from Potential Temperature 1123 1124 tmp_temp(nzb:nzt+1,j,i) = pt(nzb:nzt+1,j,i) * & 1125 ( hyp(nzb:nzt+1) / p_0 )**rd_d_cp 1126 1127 ! 1128 !-- We need to pass to cssws <- (ppm/s) * dz 1129 !-- Input is Nmole/(m^2*s) 1130 !-- To go to ppm*dz multiply the input by (m**2/N)*dz 1131 !-- (m**2/N)*dz == V/N 1132 !-- V/N = RT/P 1133 1134 conv_to_ratio(nzb:nzt+1,j,i) = rgas_univ * & ! J K-1 mol-1 1135 tmp_temp(nzb:nzt+1,j,i) / & ! K 1136 hyp(nzb:nzt+1) ! Pa 1079 !-- Derive Temperature from Potential Temperature 1080 tmp_temp(nzb:nzt+1,j,i) = pt(nzb:nzt+1,j,i) * ( hyp(nzb:nzt+1) / p_0 )**rd_d_cp 1081 1082 ! 1083 !-- We need to pass to cssws <- (ppm/s) * dz 1084 !-- Input is Nmole/(m^2*s) 1085 !-- To go to ppm*dz multiply the input by (m**2/N)*dz 1086 !-- (m**2/N)*dz == V/N 1087 !-- V/N = RT/P 1088 conv_to_ratio(nzb:nzt+1,j,i) = rgas_univ * & ! J K-1 mol-1 1089 tmp_temp(nzb:nzt+1,j,i) / & ! K 1090 hyp(nzb:nzt+1) ! Pa 1137 1091 1138 1092 ! (ecc) for reference 1139 ! m**3/Nmole (J/mol)*K^-1 K Pa 1140 ! conv_to_ratio(nzb:nzt+1,j,i) = ( (Rgas * tmp_temp(nzb:nzt+1,j,i)) / ((hyp(nzb:nzt+1))) ) 1093 ! m**3/Nmole (J/mol)*K^-1 K Pa 1094 ! conv_to_ratio(nzb:nzt+1,j,i) = ( (Rgas * tmp_temp(nzb:nzt+1,j,i)) / ((hyp(nzb:nzt+1))) ) 1141 1095 1142 1096 ENDDO … … 1150 1104 ! emis_distribution(:,nys:nyn,nxl:nxr,:) = 0.0_wp 1151 1105 1152 1106 1153 1107 ! 1154 1108 !-- LOD 2 (PRE-PROCESSED MODE) … … 1160 1114 1161 1115 ! 1162 !-- Update time indices 1163 1116 !-- Update time indices 1164 1117 CALL get_date_time( 0.0_wp, second_of_day=time_utc_init ) 1165 CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), & 1166 hour=hour_of_day ) 1167 1168 days_since_reference_point = INT( FLOOR( ( & 1169 time_utc_init + MAX( 0.0_wp, time_since_reference_point ) ) & 1170 / seconds_per_day ) ) 1118 CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), hour=hour_of_day ) 1119 1120 days_since_reference_point = INT( FLOOR( ( time_utc_init + & 1121 MAX( 0.0_wp, time_since_reference_point ) ) & 1122 / seconds_per_day ) ) 1171 1123 1172 1124 index_hh = days_since_reference_point * hours_per_day + hour_of_day 1173 1125 1174 1126 ! 1175 !-- LOD 1 (DEFAULT MODE) 1176 1127 !-- LOD 1 (DEFAULT MODE) 1177 1128 ELSEIF ( emiss_lod == 1 ) THEN 1178 1129 … … 1181 1132 1182 1133 ! 1183 !-- Allocate array where to store temporary emission values 1184 1185 IF ( .NOT. ALLOCATED(emis) ) ALLOCATE( emis(nys:nyn,nxl:nxr) ) 1186 1187 ! 1188 !-- Allocate time factor per category 1189 1134 !-- Allocate array where to store temporary emission values 1135 IF ( .NOT. ALLOCATED(emis) ) ALLOCATE( emis(nys:nyn,nxl:nxr) ) 1136 1137 ! 1138 !-- Allocate time factor per category 1190 1139 ALLOCATE( time_factor(emt_att%ncat) ) 1191 1140 1192 1141 ! 1193 !-- Read-in hourly emission time factor 1194 1195 IF ( TRIM(time_fac_type) == "HOUR" ) THEN 1196 1197 ! 1198 !-- Update time indices 1199 1200 CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), & 1142 !-- Read-in hourly emission time factor 1143 IF ( TRIM( time_fac_type ) == "HOUR" ) THEN 1144 1145 ! 1146 !-- Update time indices 1147 CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), & 1201 1148 day_of_year=day_of_year, hour=hour_of_day ) 1202 1149 index_hh = ( day_of_year - 1_iwp ) * hour_of_day 1203 1150 1204 1151 ! 1205 !-- Check if the index is less or equal to the temporal dimension of HOURLY emission files 1206 1152 !-- Check if the index is less or equal to the temporal dimension of HOURLY emission files 1207 1153 IF ( index_hh <= SIZE( emt_att%hourly_emis_time_factor(1,:) ) ) THEN 1208 1154 1209 1155 ! 1210 !-- Read-in the correspondant time factor 1211 1212 time_factor(:) = emt_att%hourly_emis_time_factor(:,index_hh+1) 1213 1214 ! 1215 !-- Error check (time out of range) 1216 1156 !-- Read-in the correspondant time factor 1157 time_factor(:) = emt_att%hourly_emis_time_factor(:,index_hh+1) 1158 1159 ! 1160 !-- Error check (time out of range) 1217 1161 ELSE 1218 1162 1219 message_string = 'The "HOUR" time-factors in the DEFAULT mode ' // &1220 ' are not provided for each hour of the total simulation time'1221 CALL message( 'chem_emissions_setup', 'CM0448', 2, 2, 0, 6, 0 ) 1163 message_string = 'The "HOUR" time-factors in the DEFAULT mode ' // & 1164 ' are not provided for each hour of the total simulation time' 1165 CALL message( 'chem_emissions_setup', 'CM0448', 2, 2, 0, 6, 0 ) 1222 1166 1223 1167 ENDIF 1224 1168 1225 1169 ! 1226 !-- Read-in MDH emissions time factors 1227 1170 !-- Read-in MDH emissions time factors 1228 1171 ELSEIF ( TRIM( time_fac_type ) == "MDH" ) THEN 1229 1172 1230 1173 ! 1231 !-- Update time indices 1232 CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), & 1233 month=month_of_year, & 1234 day=day_of_month, & 1235 hour=hour_of_day, & 1236 day_of_week=day_of_week ) 1174 !-- Update time indices 1175 CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), & 1176 month = month_of_year, & 1177 day = day_of_month, & 1178 hour = hour_of_day, & 1179 day_of_week = day_of_week & 1180 ) 1237 1181 index_mm = month_of_year 1238 1182 index_dd = months_per_year + day_of_week 1239 SELECT CASE( TRIM(daytype_mdh))1183 SELECT CASE( TRIM( daytype_mdh ) ) 1240 1184 1241 1185 CASE ("workday") … … 1249 1193 1250 1194 END SELECT 1251 ! 1252 !-- Check if the index is less or equal to the temporal dimension of MDH emission files 1253 1254 IF ( ( index_hh + index_dd + index_mm) <= SIZE( emt_att%mdh_emis_time_factor(1,:) ) ) THEN 1255 1256 ! 1257 !-- Read in corresponding time factor 1258 1259 time_factor(:) = emt_att%mdh_emis_time_factor(:,index_mm) * & 1260 emt_att%mdh_emis_time_factor(:,index_dd) * & 1195 1196 ! 1197 !-- Check if the index is less or equal to the temporal dimension of MDH emission files 1198 IF ( ( index_hh + index_dd + index_mm) <= SIZE( emt_att%mdh_emis_time_factor(1,:) ) )& 1199 THEN 1200 ! 1201 !-- Read in corresponding time factor 1202 time_factor(:) = emt_att%mdh_emis_time_factor(:,index_mm) * & 1203 emt_att%mdh_emis_time_factor(:,index_dd) * & 1261 1204 emt_att%mdh_emis_time_factor(:,index_hh+1) 1262 1205 1263 1206 ! 1264 !-- Error check (MDH time factor not provided) 1265 1207 !-- Error check (MDH time factor not provided) 1266 1208 ELSE 1267 1209 1268 message_string = 'The "MDH" time-factors in the DEFAULT mode ' // &1269 ' are not provided for each hour/day/month of the total simulation time'1210 message_string = 'The "MDH" time-factors in the DEFAULT mode ' // & 1211 ' are not provided for each hour/day/month of the total simulation time' 1270 1212 CALL message( 'chem_emissions_setup', 'CM0449', 2, 2, 0, 6, 0 ) 1271 1213 1272 ENDIF 1273 1274 ! 1275 !-- Error check (no time factor defined) 1276 1214 ENDIF 1215 1216 ! 1217 !-- Error check (no time factor defined) 1277 1218 ELSE 1278 1279 message_string = 'In the DEFAULT mode the time factor' // &1280 ' has to be defined in the NAMELIST' 1219 1220 message_string = 'In the DEFAULT mode the time factor' // & 1221 ' has to be defined in the NAMELIST' 1281 1222 CALL message( 'chem_emissions_setup', 'CM0450', 2, 2, 0, 6, 0 ) 1282 1223 1283 1224 ENDIF 1284 1225 1285 1226 ! 1286 !-- PARAMETERIZED MODE 1287 1227 !-- PARAMETERIZED MODE 1288 1228 ELSEIF ( emiss_lod == 0 ) THEN 1289 1229 … … 1291 1231 ! for reference (ecc) 1292 1232 ! ELSEIF ( TRIM( mode_emis ) == "PARAMETERIZED" ) THEN 1293 1294 ! 1295 !-- assign constant values of time factors, diurnal profile for traffic sector 1296 1297 par_emis_time_factor( : ) = (/ 0.009, 0.004, 0.004, 0.009, 0.029, 0.039, & 1298 0.056, 0.053, 0.051, 0.051, 0.052, 0.055, & 1299 0.059, 0.061, 0.064, 0.067, 0.069, 0.069, & 1233 1234 ! 1235 !-- Assign constant values of time factors, diurnal profile for traffic sector 1236 par_emis_time_factor(:) = (/ 0.009, 0.004, 0.004, 0.009, 0.029, 0.039, & 1237 0.056, 0.053, 0.051, 0.051, 0.052, 0.055, & 1238 0.059, 0.061, 0.064, 0.067, 0.069, 0.069, & 1300 1239 0.049, 0.039, 0.039, 0.029, 0.024, 0.019 /) 1301 1302 IF ( .NOT. ALLOCATED (time_factor) ) ALLOCATE (time_factor(1))1240 1241 IF ( .NOT. ALLOCATED( time_factor ) ) ALLOCATE( time_factor(1) ) 1303 1242 1304 1243 ! 1305 1244 !-- Get time-factor for specific hour 1306 CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), & 1307 hour=hour_of_day ) 1245 CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), hour = hour_of_day ) 1308 1246 1309 1247 index_hh = hour_of_day … … 1317 1255 1318 1256 ! 1319 !-- LOD 0 (PARAMETERIZED mode) 1320 1257 !-- LOD 0 (PARAMETERIZED mode) 1321 1258 IF ( emiss_lod == 0 ) THEN 1322 1259 … … 1328 1265 ! 1329 1266 !-- Units are micromoles/m**2*day (or kilograms/m**2*day for PMs) 1330 1331 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1332 surface_csflux(match_spec_input(ispec)) * & 1333 time_factor(1) * hour_to_s 1334 1335 ENDDO 1336 1337 1338 ! 1339 !-- LOD 1 (DEFAULT mode) 1340 1341 1267 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = surface_csflux( match_spec_input(ispec) )& 1268 * time_factor(1) * hour_to_s 1269 1270 ENDDO 1271 1272 1273 ! 1274 !-- LOD 1 (DEFAULT mode) 1342 1275 ELSEIF ( emiss_lod == 1 ) THEN 1343 1276 … … 1346 1279 1347 1280 ! 1348 !-- Allocate array for the emission value corresponding to a specific category and time factor 1349 1281 !-- Allocate array for the emission value corresponding to a specific category and time factor 1350 1282 ALLOCATE (delta_emis(nys:nyn,nxl:nxr)) 1351 1283 1352 1284 ! 1353 !-- Cycle over categories 1354 1285 !-- Cycle over categories 1355 1286 DO icat = 1, emt_att%ncat 1356 1357 ! 1358 !-- Cycle over Species: n_matched_vars represents the number of species 1359 !-- in common between the emission input data and the chemistry mechanism used 1360 1287 1288 ! 1289 !-- Cycle over Species: n_matched_vars represents the number of species in common between 1290 !-- the emission input data and the chemistry mechanism used 1361 1291 DO ispec = 1, n_matched_vars 1362 1292 1363 emis(nys:nyn,nxl:nxr) = & 1364 emt(match_spec_input(ispec))% & 1365 default_emission_data(icat,nys+1:nyn+1,nxl+1:nxr+1) 1366 1367 ! 1368 !-- NO 1369 1370 IF ( TRIM(spc_names(match_spec_model(ispec))) == "NO" ) THEN 1371 1372 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & ! kg/m2/s 1373 time_factor(icat) * & 1374 emt_att%nox_comp(icat,1) * & 1293 emis(nys:nyn,nxl:nxr) = emt( match_spec_input(ispec) )% & 1294 default_emission_data(icat,nys+1:nyn+1,nxl+1:nxr+1) 1295 1296 ! 1297 !-- NO 1298 IF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "NO" ) THEN 1299 1300 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & ! kg/m2/s 1301 time_factor(icat) * & 1302 emt_att%nox_comp(icat,1) * & 1375 1303 conversion_factor * hours_per_day 1376 1304 1377 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1378 emis_distribution(1,nys:nyn,nxl:nxr,ispec) + & 1379 delta_emis(nys:nyn,nxl:nxr) 1380 ! 1381 !-- NO2 1382 1383 ELSEIF ( TRIM(spc_names(match_spec_model(ispec))) == "NO2" ) THEN 1384 1385 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & ! kg/m2/s 1386 time_factor(icat) * & 1387 emt_att%nox_comp(icat,2) * & 1305 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1306 emis_distribution(1,nys:nyn,nxl:nxr,ispec)& 1307 + delta_emis(nys:nyn,nxl:nxr) 1308 ! 1309 !-- NO2 1310 ELSEIF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "NO2" ) THEN 1311 1312 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & ! kg/m2/s 1313 time_factor(icat) * & 1314 emt_att%nox_comp(icat,2) * & 1388 1315 conversion_factor * hours_per_day 1389 1316 1390 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = &1391 emis_distribution(1,nys:nyn,nxl:nxr,ispec) +&1392 delta_emis(nys:nyn,nxl:nxr)1393 1394 ! 1395 !-- SO21396 ELSEIF ( TRIM( spc_names(match_spec_model(ispec))) == "SO2" ) THEN1397 1398 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & ! kg/m2/s1399 time_factor(icat) * &1400 emt_att%sox_comp(icat,1) * &1317 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1318 emis_distribution(1,nys:nyn,nxl:nxr,ispec) & 1319 + delta_emis(nys:nyn,nxl:nxr) 1320 1321 ! 1322 !-- SO2 1323 ELSEIF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "SO2" ) THEN 1324 1325 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & ! kg/m2/s 1326 time_factor(icat) * & 1327 emt_att%sox_comp(icat,1) * & 1401 1328 conversion_factor * hours_per_day 1402 1329 1403 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1404 emis_distribution(1,nys:nyn,nxl:nxr,ispec) + & 1405 delta_emis(nys:nyn,nxl:nxr) 1406 1407 ! 1408 !-- SO4 1409 1410 ELSEIF ( TRIM(spc_names(match_spec_model(ispec))) == "SO4" ) THEN 1411 1412 1413 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & ! kg/m2/s 1414 time_factor(icat) * & 1415 emt_att%sox_comp(icat,2) * & 1330 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1331 emis_distribution(1,nys:nyn,nxl:nxr,ispec) & 1332 + delta_emis(nys:nyn,nxl:nxr) 1333 1334 ! 1335 !-- SO4 1336 ELSEIF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "SO4" ) THEN 1337 1338 1339 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & ! kg/m2/s 1340 time_factor(icat) * & 1341 emt_att%sox_comp(icat,2) * & 1416 1342 conversion_factor * hours_per_day 1417 1343 1418 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1419 emis_distribution(1,nys:nyn,nxl:nxr,ispec) + & 1420 delta_emis(nys:nyn,nxl:nxr) 1421 1422 1423 ! 1424 !-- PM1 1425 1426 ELSEIF ( TRIM(spc_names(match_spec_model(ispec))) == "PM1" ) THEN 1344 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1345 emis_distribution(1,nys:nyn,nxl:nxr,ispec) & 1346 + delta_emis(nys:nyn,nxl:nxr) 1347 1348 1349 ! 1350 !-- PM1 1351 ELSEIF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1" ) THEN 1427 1352 1428 1353 DO i_pm_comp = 1, SIZE( emt_att%pm_comp(1,:,1) ) ! cycle through components 1429 1354 1430 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * 1431 time_factor(icat) * &1432 emt_att%pm_comp(icat,i_pm_comp,1) * &1433 conversion_factor * hours_per_day 1434 1435 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = &1436 emis_distribution(1,nys:nyn,nxl:nxr,ispec) +&1437 delta_emis(nys:nyn,nxl:nxr)1355 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & ! kg/m2/s 1356 time_factor(icat) * & 1357 emt_att%pm_comp(icat,i_pm_comp,1) * & 1358 conversion_factor * hours_per_day 1359 1360 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1361 emis_distribution(1,nys:nyn,nxl:nxr,ispec) & 1362 + delta_emis(nys:nyn,nxl:nxr) 1438 1363 1439 1364 ENDDO 1440 1365 1441 1366 ! 1442 !-- PM2.5 1443 1444 ELSEIF ( TRIM(spc_names(match_spec_model(ispec))) == "PM25" ) THEN 1367 !-- PM2.5 1368 ELSEIF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25" ) THEN 1445 1369 1446 1370 DO i_pm_comp = 1, SIZE( emt_att%pm_comp(1,:,2) ) ! cycle through components 1447 1371 1448 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * 1449 time_factor(icat) * &1450 emt_att%pm_comp(icat,i_pm_comp,2) * &1451 conversion_factor * hours_per_day 1452 1453 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = &1454 emis_distribution(1,nys:nyn,nxl:nxr,ispec) +&1455 delta_emis(nys:nyn,nxl:nxr)1456 1372 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & ! kg/m2/s 1373 time_factor(icat) * & 1374 emt_att%pm_comp(icat,i_pm_comp,2) * & 1375 conversion_factor * hours_per_day 1376 1377 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1378 emis_distribution(1,nys:nyn,nxl:nxr,ispec) & 1379 + delta_emis(nys:nyn,nxl:nxr) 1380 1457 1381 ENDDO 1458 1382 1459 1383 ! 1460 !-- PM10 1461 1462 ELSEIF ( TRIM(spc_names(match_spec_model(ispec))) == "PM10" ) THEN 1384 !-- PM10 1385 ELSEIF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" ) THEN 1463 1386 1464 1387 DO i_pm_comp = 1, SIZE( emt_att%pm_comp(1,:,3) ) ! cycle through components 1465 1388 1466 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * 1467 time_factor(icat) * &1468 emt_att%pm_comp(icat,i_pm_comp,3) * &1469 conversion_factor * hours_per_day 1470 1471 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = &1472 emis_distribution(1,nys:nyn,nxl:nxr,ispec) +&1473 delta_emis(nys:nyn,nxl:nxr)1389 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & ! kg/m2/s 1390 time_factor(icat) * & 1391 emt_att%pm_comp(icat,i_pm_comp,3) * & 1392 conversion_factor * hours_per_day 1393 1394 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1395 emis_distribution(1,nys:nyn,nxl:nxr,ispec) & 1396 + delta_emis(nys:nyn,nxl:nxr) 1474 1397 1475 1398 ENDDO 1476 1399 1477 1400 ! 1478 !-- VOCs 1479 1401 !-- VOCs 1480 1402 ELSEIF ( SIZE( match_spec_voc_input ) > 0 ) THEN 1481 1403 1482 1404 DO ivoc = 1, SIZE( match_spec_voc_input ) ! cycle through components 1483 1405 1484 IF ( TRIM( spc_names(match_spec_model(ispec))) ==&1485 TRIM( emt_att%voc_name(ivoc)) ) THEN1486 1487 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * &1488 time_factor(icat) * &1489 emt_att%voc_comp(icat,match_spec_voc_input(ivoc)) * 1406 IF ( TRIM( spc_names(match_spec_model(ispec) ) ) == & 1407 TRIM( emt_att%voc_name(ivoc) ) ) THEN 1408 1409 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & 1410 time_factor(icat) * & 1411 emt_att%voc_comp(icat,match_spec_voc_input(ivoc)) * & 1490 1412 conversion_factor * hours_per_day 1491 1413 1492 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = &1493 emis_distribution(1,nys:nyn,nxl:nxr,ispec) +&1494 delta_emis(nys:nyn,nxl:nxr)1495 1496 ENDIF 1414 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1415 emis_distribution(1,nys:nyn,nxl:nxr,ispec) & 1416 + delta_emis(nys:nyn,nxl:nxr) 1417 1418 ENDIF 1497 1419 1498 1420 ENDDO 1499 1500 ! 1501 !-- any other species 1502 1421 1422 ! 1423 !-- Any other species 1503 1424 ELSE 1504 1425 1505 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * & 1506 time_factor(icat) * & 1426 delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) * time_factor(icat) * & 1507 1427 conversion_factor * hours_per_day 1508 1509 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = &1510 emis_distribution(1,nys:nyn,nxl:nxr,ispec) +&1511 delta_emis(nys:nyn,nxl:nxr)1428 1429 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1430 emis_distribution(1,nys:nyn,nxl:nxr,ispec) & 1431 + delta_emis(nys:nyn,nxl:nxr) 1512 1432 1513 1433 ENDIF ! TRIM spc_names 1514 1515 emis = 0 1516 1434 1435 emis = 0 1436 1517 1437 ENDDO 1518 1519 delta_emis = 0 1520 1438 1439 delta_emis = 0 1440 1521 1441 ENDDO 1522 1442 1523 1443 ! 1524 !-- LOD 2 (PRE-PROCESSED mode) 1525 1444 !-- LOD 2 (PRE-PROCESSED mode) 1526 1445 ELSEIF ( emiss_lod == 2 ) THEN 1527 1446 … … 1530 1449 1531 1450 ! 1532 !-- Cycle over species: n_matched_vars represents the number of species 1533 !-- in common between the emission input data and the chemistry mechanism used 1534 1535 DO ispec = 1, n_matched_vars 1536 1537 ! (ecc) 1538 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = & 1539 emt(match_spec_input(ispec))% & 1540 preproc_emission_data(index_hh+1,1,nys+1:nyn+1,nxl+1:nxr+1) * & 1541 conversion_factor 1451 !-- Cycle over species: n_matched_vars represents the number of species in common between the 1452 !-- emission input data and the chemistry mechanism used 1453 DO ispec = 1, n_matched_vars 1454 1455 ! (ecc) 1456 emis_distribution(1,nys:nyn,nxl:nxr,ispec) = emt(match_spec_input(ispec))% & 1457 preproc_emission_data(index_hh+1,1,nys+1:nyn+1,nxl+1:nxr+1) & 1458 * conversion_factor 1542 1459 1543 1460 … … 1550 1467 ENDIF ! emiss_lod 1551 1468 1552 1553 ! 1554 !-- Cycle to transform x,y coordinates to the one of surface_mod and to assign emission values to cssws1555 1556 ! 1557 ! -- LOD 0 (PARAMETERIZED mode)1558 !-- Units of inputs are micromoles/m2/s1559 1469 1470 ! 1471 !-- Cycle to transform x,y coordinates to the one of surface_mod and to assign emission values to 1472 !-- cssws 1473 1474 ! 1475 !-- LOD 0 (PARAMETERIZED mode) 1476 !-- Units of inputs are micromoles/m2/s 1560 1477 IF ( emiss_lod == 0 ) THEN 1561 1478 ! for reference (ecc) … … 1565 1482 1566 1483 ! 1567 !-- Streets are lsm surfaces, hence, no usm surface treatment required. 1568 !-- However, urban surface may be initialized via default initialization 1569 !-- in surface_mod, e.g. at horizontal urban walls that are at k == 0 1570 !-- (building is lower than the first grid point). Hence, in order to 1571 !-- have only emissions at streets, set the surfaces emissions to zero 1572 !-- at urban walls. 1573 1484 !-- Streets are lsm surfaces, hence, no usm surface treatment required. 1485 !-- However, urban surface may be initialized via default initialization in surface_mod, e.g. at 1486 !-- horizontal urban walls that are at k == 0 (building is lower than the first grid point). Hence, 1487 !-- in order to have only emissions at streets, set the surfaces emissions to zero at urban walls. 1574 1488 IF ( surf_usm_h%ns >=1 ) surf_usm_h%cssws = 0.0_wp 1575 1489 1576 1490 ! 1577 !-- Treat land-surfaces. 1578 1491 !-- Treat land-surfaces. 1579 1492 DO m = 1, surf_lsm_h%ns 1580 1493 … … 1584 1497 1585 1498 ! 1586 !-- set everything to zero then reassign according to street type 1587 1499 !-- Set everything to zero then reassign according to street type 1588 1500 surf_lsm_h%cssws(:,m) = 0.0_wp 1589 1501 1590 IF ( street_type_f%var(j,i) >= main_street_id .AND.&1502 IF ( street_type_f%var(j,i) >= main_street_id .AND. & 1591 1503 street_type_f%var(j,i) < max_street_id ) THEN 1592 1504 1593 1505 ! 1594 !-- Cycle over matched species 1595 1506 !-- Cycle over matched species 1596 1507 DO ispec = 1, n_matched_vars 1597 1508 1598 1509 ! 1599 !-- PMs are already in kilograms 1600 1601 IF ( TRIM(spc_names(match_spec_model(ispec))) == "PM1" .OR. & 1602 TRIM(spc_names(match_spec_model(ispec))) == "PM25" .OR. & 1603 TRIM(spc_names(match_spec_model(ispec))) == "PM10" ) THEN 1604 1605 ! 1606 !-- kg/(m^2*s) * kg/m^3 1607 surf_lsm_h%cssws(match_spec_model(ispec),m) = & 1608 emiss_factor_main(match_spec_input(ispec)) * & 1609 emis_distribution(1,j,i,ispec) * & ! kg/(m^2*s) 1610 rho_air(k) ! kg/m^3 1611 1612 ! 1613 !-- Other Species 1614 !-- Inputs are micromoles 1615 1510 !-- PMs are already in kilograms 1511 IF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1" .OR. & 1512 TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25" .OR. & 1513 TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" ) THEN 1514 1515 ! 1516 !-- kg/(m^2*s) * kg/m^3 1517 surf_lsm_h%cssws(match_spec_model(ispec),m) = & 1518 emiss_factor_main(match_spec_input(ispec)) * & 1519 emis_distribution(1,j,i,ispec) * & ! kg/(m^2*s) 1520 rho_air(k) ! kg/m^3 1521 1522 ! 1523 !-- Other Species 1524 !-- Inputs are micromoles 1616 1525 ELSE 1617 1526 1618 ! 1619 !-- ppm/s *m *kg/m^31620 surf_lsm_h%cssws(match_spec_model(ispec),m) = &1621 emiss_factor_main( match_spec_input(ispec)) *&1622 emis_distribution(1,j,i,ispec) * 1623 conv_to_ratio(k,j,i) * & ! m^3/Nmole1624 rho_air(k) 1527 ! 1528 !-- ppm/s *m *kg/m^3 1529 surf_lsm_h%cssws(match_spec_model(ispec),m) = & 1530 emiss_factor_main( match_spec_input(ispec) ) * & 1531 emis_distribution(1,j,i,ispec) * & ! micromoles/(m^2*s) 1532 conv_to_ratio(k,j,i) * & ! m^3/Nmole 1533 rho_air(k) ! kg/m^3 1625 1534 1626 1535 ENDIF … … 1629 1538 1630 1539 1631 ELSEIF ( street_type_f%var(j,i) >= side_street_id .AND. &1540 ELSEIF ( street_type_f%var(j,i) >= side_street_id .AND. & 1632 1541 street_type_f%var(j,i) < main_street_id ) THEN 1633 1542 1634 1543 ! 1635 !-- Cycle over matched species 1636 1544 !-- Cycle over matched species 1637 1545 DO ispec = 1, n_matched_vars 1638 1546 1639 1547 ! 1640 !-- PMs are already in kilograms 1641 1642 IF ( TRIM(spc_names(match_spec_model(ispec))) == "PM1" .OR. & 1643 TRIM(spc_names(match_spec_model(ispec))) == "PM25" .OR. & 1644 TRIM(spc_names(match_spec_model(ispec))) == "PM10" ) THEN 1645 1646 ! 1647 !-- kg/(m^2*s) * kg/m^3 1648 surf_lsm_h%cssws(match_spec_model(ispec),m) = & 1649 emiss_factor_side(match_spec_input(ispec)) * & 1650 emis_distribution(1,j,i,ispec) * & ! kg/(m^2*s) 1651 rho_air(k) ! kg/m^3 1652 ! 1653 !-- Other species 1654 !-- Inputs are micromoles 1655 1548 !-- PMs are already in kilograms 1549 IF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1" .OR. & 1550 TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25" .OR. & 1551 TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" ) THEN 1552 1553 ! 1554 !-- kg/(m^2*s) * kg/m^3 1555 surf_lsm_h%cssws(match_spec_model(ispec),m) = & 1556 emiss_factor_side( match_spec_input(ispec) ) * & 1557 emis_distribution(1,j,i,ispec) * & ! kg/(m^2*s) 1558 rho_air(k) ! kg/m^3 1559 ! 1560 !-- Other species 1561 !-- Inputs are micromoles 1656 1562 ELSE 1657 1563 1658 ! 1659 !-- ppm/s *m *kg/m^3 1660 1661 surf_lsm_h%cssws(match_spec_model(ispec),m) = & 1662 emiss_factor_side(match_spec_input(ispec)) * & 1663 emis_distribution(1,j,i,ispec) * & ! micromoles/(m^2*s) 1664 conv_to_ratio(k,j,i) * & ! m^3/Nmole 1665 rho_air(k) ! kg/m^3 1564 ! 1565 !-- ppm/s *m *kg/m^3 1566 surf_lsm_h%cssws(match_spec_model(ispec),m) = & 1567 emiss_factor_side( match_spec_input(ispec) ) * & 1568 emis_distribution(1,j,i,ispec) * & ! micromoles/(m^2*s) 1569 conv_to_ratio(k,j,i) * & ! m^3/Nmole 1570 rho_air(k) ! kg/m^3 1666 1571 1667 1572 ENDIF … … 1671 1576 ! 1672 1577 !-- If no street type is defined, then assign zero emission to all the species 1673 1674 1578 ! (ecc) moved to front (for reference) 1675 1579 ! ELSE … … 1685 1589 1686 1590 ! 1687 !-- LOD 1 (DEFAULT) and LOD 2 (PRE-PROCESSED) 1688 1689 1690 ELSE 1691 1692 1693 DO ispec = 1, n_matched_vars 1694 1591 !-- LOD 1 (DEFAULT) and LOD 2 (PRE-PROCESSED) 1592 ELSE 1593 1594 1595 DO ispec = 1, n_matched_vars 1596 1695 1597 ! 1696 1598 !-- Default surfaces 1697 1698 1599 DO m = 1, surf_def_h(0)%ns 1699 1600 … … 1704 1605 1705 1606 ! 1706 !-- PMs1707 IF ( TRIM( spc_names(match_spec_model(ispec))) == "PM1" .OR.&1708 TRIM( spc_names(match_spec_model(ispec))) == "PM25" .OR.&1709 TRIM( spc_names(match_spec_model(ispec))) == "PM10" ) THEN1710 1711 surf_def_h(0)%cssws(match_spec_model(ispec),m) = 1712 emis_distribution(1,j,i,ispec)*& ! kg/m2/s1713 rho_air(nzb) ! kg/m^31714 1607 !-- PMs 1608 IF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1" .OR. & 1609 TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25" .OR. & 1610 TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" ) THEN 1611 1612 surf_def_h(0)%cssws(match_spec_model(ispec),m) = & ! kg/m2/s * kg/m3 1613 emis_distribution(1,j,i,ispec) * & ! kg/m2/s 1614 rho_air(nzb) ! kg/m^3 1615 1715 1616 ELSE 1716 1617 1717 1618 ! 1718 !-- VOCs1719 IF ( len_index_voc > 0 .AND.&1619 !-- VOCs 1620 IF ( len_index_voc > 0 .AND. & 1720 1621 emt_att%species_name(match_spec_input(ispec)) == "VOC" ) THEN 1721 1622 1722 surf_def_h(0)%cssws(match_spec_model(ispec),m) = & ! ppm/s * m * kg/m3 1723 emis_distribution(1,j,i,ispec) * & ! mole/m2/s 1724 conv_to_ratio(nzb,j,i) * & ! m^3/mole 1725 ratio2ppm * & ! ppm 1726 rho_air(nzb) ! kg/m^3 1727 1728 1729 ! 1730 !-- Other species 1731 1623 surf_def_h(0)%cssws(match_spec_model(ispec),m) = & ! ppm/s * m * kg/m3 1624 emis_distribution(1,j,i,ispec) * & ! mole/m2/s 1625 conv_to_ratio(nzb,j,i) * & ! m^3/mole 1626 ratio2ppm * & ! ppm 1627 rho_air(nzb) ! kg/m^3 1628 1629 1630 ! 1631 !-- Other species 1732 1632 ELSE 1733 1633 1734 surf_def_h(0)%cssws(match_spec_model(ispec),m) = 1735 emis_distribution(1,j,i,ispec) * 1736 ( 1.0_wp / emt_att%xm(ispec) ) * & ! mole/kg1737 conv_to_ratio(nzb,j,i) * & ! m^3/mole1738 ratio2ppm * & ! ppm1739 rho_air(nzb) ! kg/m^31740 1634 surf_def_h(0)%cssws(match_spec_model(ispec),m) = & ! ppm/s * m * kg/m3 1635 emis_distribution(1,j,i,ispec) * & ! kg/m2/s 1636 ( 1.0_wp / emt_att%xm(ispec) ) * & ! mole/kg 1637 conv_to_ratio(nzb,j,i) * & ! m^3/mole 1638 ratio2ppm * & ! ppm 1639 rho_air(nzb) ! kg/m^3 1640 1741 1641 ENDIF ! VOC 1742 1642 … … 1746 1646 1747 1647 ENDDO ! m 1748 1749 ! 1750 !-- LSM surfaces 1751 1752 1648 1649 ! 1650 !-- LSM surfaces 1753 1651 DO m = 1, surf_lsm_h%ns 1754 1652 … … 1760 1658 1761 1659 ! 1762 !-- PMs1763 IF ( TRIM( spc_names(match_spec_model(ispec))) == "PM1" .OR.&1764 TRIM( spc_names(match_spec_model(ispec))) == "PM25" .OR.&1765 TRIM( spc_names(match_spec_model(ispec))) == "PM10" ) THEN1766 1767 surf_lsm_h%cssws(match_spec_model(ispec),m) = 1768 emis_distribution(1,j,i,ispec) *& ! kg/m2/s1769 rho_air(k)! kg/m^31770 1660 !-- PMs 1661 IF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1" .OR. & 1662 TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25" .OR. & 1663 TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" ) THEN 1664 1665 surf_lsm_h%cssws(match_spec_model(ispec),m) = & ! kg/m2/s * kg/m3 1666 emis_distribution(1,j,i,ispec) * & ! kg/m2/s 1667 rho_air(k) ! kg/m^3 1668 1771 1669 ELSE 1772 1670 1773 1671 ! 1774 !-- VOCs 1775 1672 !-- VOCs 1776 1673 IF ( len_index_voc > 0 .AND. & 1777 1674 emt_att%species_name(match_spec_input(ispec)) == "VOC" ) THEN 1778 1675 1779 surf_lsm_h%cssws(match_spec_model(ispec),m) = & ! ppm/s * m * kg/m3 1780 emis_distribution(1,j,i,ispec) * & ! mole/m2/s 1781 conv_to_ratio(k,j,i) * & ! m^3/mole 1782 ratio2ppm * & ! ppm 1783 rho_air(k) ! kg/m^3 1784 1785 ! 1786 !-- Other species 1787 1676 surf_lsm_h%cssws(match_spec_model(ispec),m) = & ! ppm/s * m * kg/m3 1677 emis_distribution(1,j,i,ispec) * & ! mole/m2/s 1678 conv_to_ratio(k,j,i) * & ! m^3/mole 1679 ratio2ppm * & ! ppm 1680 rho_air(k) ! kg/m^3 1681 1682 ! 1683 !-- Other species 1788 1684 ELSE 1789 1685 1790 surf_lsm_h%cssws(match_spec_model(ispec),m) = 1791 emis_distribution(1,j,i,ispec) * 1792 ( 1.0_wp / emt_att%xm(ispec) ) * 1793 conv_to_ratio(k,j,i) *& ! m^3/mole1794 ratio2ppm *& ! ppm1795 rho_air(k) ! kg/m^31796 1686 surf_lsm_h%cssws(match_spec_model(ispec),m) = & ! ppm/s * m * kg/m3 1687 emis_distribution(1,j,i,ispec) * & ! kg/m2/s 1688 ( 1.0_wp / emt_att%xm(ispec) ) * & ! mole/kg 1689 conv_to_ratio(k,j,i) * & ! m^3/mole 1690 ratio2ppm * & ! ppm 1691 rho_air(k) ! kg/m^3 1692 1797 1693 ENDIF ! VOC 1798 1694 … … 1806 1702 1807 1703 ! 1808 !-- USM surfaces 1809 1704 !-- USM surfaces 1810 1705 DO m = 1, surf_usm_h%ns 1811 1706 … … 1817 1712 1818 1713 ! 1819 !-- PMs1820 IF ( TRIM( spc_names(match_spec_model(ispec))) == "PM1" .OR.&1821 TRIM( spc_names(match_spec_model(ispec))) == "PM25" .OR.&1822 TRIM( spc_names(match_spec_model(ispec))) == "PM10" ) THEN1823 1824 surf_usm_h%cssws(match_spec_model(ispec),m) = 1825 emis_distribution(1,j,i,ispec) *& ! kg/m2/s1714 !-- PMs 1715 IF ( TRIM( spc_names( match_spec_model(ispec) ) ) == "PM1" .OR. & 1716 TRIM( spc_names( match_spec_model(ispec) ) ) == "PM25" .OR. & 1717 TRIM( spc_names( match_spec_model(ispec) ) ) == "PM10" ) THEN 1718 1719 surf_usm_h%cssws(match_spec_model(ispec),m) = & ! kg/m2/s * kg/m3 1720 emis_distribution(1,j,i,ispec) * & ! kg/m2/s 1826 1721 rho_air(k) ! kg/m^3 1827 1722 1828 1723 ELSE 1829 1724 1830 1725 ! 1831 1726 !-- VOCs 1832 IF ( len_index_voc > 0 .AND.&1727 IF ( len_index_voc > 0 .AND. & 1833 1728 emt_att%species_name(match_spec_input(ispec)) == "VOC" ) THEN 1834 1729 1835 surf_usm_h%cssws(match_spec_model(ispec),m) = 1836 emis_distribution(1,j,i,ispec) * 1837 conv_to_ratio(k,j,i) *& ! m^3/mole1838 ratio2ppm *& ! ppm1839 rho_air(k) ! kg/m^31730 surf_usm_h%cssws(match_spec_model(ispec),m) = & ! ppm/s * m * kg/m3 1731 emis_distribution(1,j,i,ispec) * & ! m2/s 1732 conv_to_ratio(k,j,i) * & ! m^3/mole 1733 ratio2ppm * & ! ppm 1734 rho_air(k) ! kg/m^3 1840 1735 1841 1736 ! … … 1843 1738 ELSE 1844 1739 1845 surf_usm_h%cssws(match_spec_model(ispec),m) = 1846 emis_distribution(1,j,i,ispec) * 1847 ( 1.0_wp / emt_att%xm(ispec) ) * 1848 conv_to_ratio(k,j,i) *& ! m^3/mole1849 ratio2ppm *& ! ppm1850 rho_air(k) ! kg/m^31740 surf_usm_h%cssws(match_spec_model(ispec),m) = & ! ppm/s * m * kg/m3 1741 emis_distribution(1,j,i,ispec) * & ! kg/m2/s 1742 ( 1.0_wp / emt_att%xm(ispec) ) * & ! mole/kg 1743 conv_to_ratio(k,j,i) * & ! m^3/mole 1744 ratio2ppm * & ! ppm 1745 rho_air(k) ! kg/m^3 1851 1746 1852 1747 … … 1864 1759 1865 1760 ! 1866 !-- Deallocate time_factor in case of DEFAULT mode) 1867 1868 IF ( ALLOCATED (time_factor) ) DEALLOCATE (time_factor) 1761 !-- Deallocate time_factor in case of DEFAULT mode) 1762 IF ( ALLOCATED( time_factor ) ) DEALLOCATE( time_factor ) 1869 1763 1870 1764 ENDIF … … 1898 1792 !-- 20200203 (ECC) 1899 1793 ! 1900 !------------------------------------------------------------------------------ !1794 !--------------------------------------------------------------------------------------------------! 1901 1795 ! Description: 1902 1796 ! ------------ 1903 1797 !> interface for initiation of emission arrays based on emission LOD 1904 1798 ! 1905 !------------------------------------------------------------------------------ !1799 !--------------------------------------------------------------------------------------------------! 1906 1800 1907 1801 SUBROUTINE chem_emissions_header_init … … 1924 1818 !-- 20200203 (ECC) 1925 1819 ! 1926 !------------------------------------------------------------------------------ !1820 !--------------------------------------------------------------------------------------------------! 1927 1821 ! Description: 1928 1822 ! ------------ 1929 1823 !> interface for initiation of emission arrays based on emission LOD 1930 ! 1931 !------------------------------------------------------------------------------! 1824 !--------------------------------------------------------------------------------------------------! 1932 1825 1933 1826 SUBROUTINE chem_emissions_update_on_demand … … 1946 1839 END SUBROUTINE ! chem_emisisons_update_on_demand 1947 1840 1948 1841 1949 1842 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1950 1843 !! … … 1956 1849 !-- 20200203 (ECC) 1957 1850 ! 1958 !------------------------------------------------------------------------------ !1851 !--------------------------------------------------------------------------------------------------! 1959 1852 ! Description: 1960 1853 ! ------------ 1961 1854 !> Initiates header for emissions data attributes for LOD 2 1962 !------------------------------------------------------------------------------ !1855 !--------------------------------------------------------------------------------------------------! 1963 1856 1964 1857 SUBROUTINE chem_emissions_header_init_lod2 1965 1858 1966 USE control_parameters, &1859 USE control_parameters, & 1967 1860 ONLY: coupling_char, message_string 1968 1861 1969 USE netcdf_data_input_mod, & 1970 ONLY: chem_emis_att, & 1971 open_read_file, close_input_file, & 1972 get_dimension_length, get_variable, & 1973 get_attribute 1862 USE netcdf_data_input_mod, & 1863 ONLY: chem_emis_att, close_input_file, get_attribute, get_dimension_length, get_variable, & 1864 open_read_file 1865 1974 1866 1975 1867 IMPLICIT NONE 1976 1868 1869 1870 INTEGER(iwp) :: att_lod !< lod attribute in chemistry file 1977 1871 INTEGER(iwp) :: ncid !< chemistry file netCDF handle 1978 INTEGER(iwp) :: att_lod !< lod attribute in chemistry file 1979 1980 IF ( debug_output ) & 1981 CALL debug_message( 'chem_emissions_header_init_lod2', 'start' ) 1982 1983 ! 1984 !-- opens _chemistry input file and obtain header information 1985 1986 CALL open_read_file ( TRIM(input_file_chem) // TRIM(coupling_char), ncid ) 1987 ! 1988 !-- check if LOD in chemistry file matches LOD in namelist 1989 1872 1873 IF ( debug_output ) CALL debug_message( 'chem_emissions_header_init_lod2', 'start' ) 1874 1875 ! 1876 !-- Opens _chemistry input file and obtain header information 1877 CALL open_read_file ( TRIM( input_file_chem ) // TRIM( coupling_char ), ncid ) 1878 ! 1879 !-- Check if LOD in chemistry file matches LOD in namelist 1990 1880 CALL get_attribute ( ncid, 'lod', att_lod, .TRUE. ) 1991 1881 1992 1882 IF ( att_lod /= emiss_lod ) THEN 1993 1883 message_string = '' ! to get around unused variable warning / error 1994 WRITE ( message_string, * ) & 1995 'LOD mismatch between namelist (emiss_lod) and', & 1996 CHAR(10), ' ', & 1997 'chemistry input file (global attributes>lod)' 1884 WRITE ( message_string, * ) 'LOD mismatch between namelist (emiss_lod) and', & 1885 CHAR( 10 ), ' ', 'chemistry input file (global attributes>lod)' 1998 1886 CALL message( 'chem_emissions_header_init_lod2', 'CM0468', 1, 2, 0, 6, 0 ) 1999 1887 ENDIF 2000 1888 ! 2001 !-- obtain unit conversion factor 2002 1889 !-- Obtain unit conversion factor 2003 1890 CALL get_attribute ( ncid, 'units', chem_emis_att%units, .FALSE., "emission_values" ) 2004 1891 conversion_factor = chem_emissions_convert_base_units ( chem_emis_att%units ) 2005 1892 ! 2006 !-- obtain header attributes 2007 1893 !-- Obtain header attributes 2008 1894 CALL chem_emissions_init_species ( ncid ) 2009 1895 CALL chem_emissions_init_timestamps ( ncid ) 2010 1896 ! 2011 !-- done reading file 2012 1897 !-- Done reading file 2013 1898 CALL close_input_file (ncid) 2014 1899 2015 1900 ! 2016 !-- set previous timestamp index to something different 2017 !-- to trigger a read event later on 2018 1901 !-- Set previous timestamp index to something different to trigger a read event later on 2019 1902 previous_timestamp_index = -1 2020 2021 IF ( debug_output ) & 2022 CALL debug_message( 'chem_emissions_header_init_lod2', 'end' ) 1903 1904 IF ( debug_output ) CALL debug_message( 'chem_emissions_header_init_lod2', 'end' ) 2023 1905 2024 1906 END SUBROUTINE chem_emissions_header_init_lod2 … … 2027 1909 !-- 20200203 (ECC) 2028 1910 ! 2029 !------------------------------------------------------------------------------ !1911 !--------------------------------------------------------------------------------------------------! 2030 1912 ! Description: 2031 1913 ! ------------ 2032 1914 !> Reads emission data on demand for LOD2 2033 !------------------------------------------------------------------------------ !1915 !--------------------------------------------------------------------------------------------------! 2034 1916 2035 1917 SUBROUTINE chem_emissions_update_on_demand_lod2 2036 1918 2037 USE control_parameters, & 2038 ONLY: coupling_char, & 2039 time_since_reference_point 2040 2041 USE netcdf_data_input_mod, & 2042 ONLY: chem_emis_att, & 2043 open_read_file, close_input_file, get_variable 2044 2045 USE arrays_3d, & 2046 ONLY: pt, hyp 2047 2048 USE surface_mod, & 1919 USE control_parameters, & 1920 ONLY: coupling_char, time_since_reference_point 1921 1922 USE netcdf_data_input_mod, & 1923 ONLY: chem_emis_att, close_input_file, get_variable, open_read_file 1924 1925 USE arrays_3d, & 1926 ONLY: hyp, pt 1927 1928 USE surface_mod, & 2049 1929 ONLY: surf_def_h, surf_lsm_h, surf_usm_h 2050 1930 … … 2052 1932 IMPLICIT NONE 2053 1933 2054 CHARACTER(LEN=80) :: this_timestamp !< writes out timestamp1934 CHARACTER(LEN=80) :: this_timestamp !< writes out timestamp 2055 1935 2056 1936 INTEGER(iwp) :: i,j,k,m !< generic counters … … 2059 1939 INTEGER(iwp) :: time_index_location !< location of most recent timestamp 2060 1940 2061 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:,:) :: emissions_raw !< raw emissions data2062 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: emis_distrib !< surface emissions2063 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: mass2mole !< conversion factor mass 2 molar (ppm) flux2064 1941 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: cssws_def_h !< dummy default surface array 2065 1942 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: cssws_lsm_h !< dummy LSM surface array 2066 1943 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: cssws_usm_h !< dummy USM surface array 2067 2068 IF ( debug_output ) & 2069 CALL debug_message ( 'chem_emissions_update_on_demand_lod2', 'start' ) 2070 ! 2071 !-- obtain current timestamp and locate index 2072 !-- for most recent timestamp element 2073 !-- end subroutine (RETURN) if it is still the same 2074 !-- index as the existing time index 1944 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: mass2mole !< conversion factor mass 2 molar (ppm) flux 1945 1946 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: emis_distrib !< surface emissions 1947 1948 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:,:) :: emissions_raw !< raw emissions data 1949 1950 IF ( debug_output ) CALL debug_message ( 'chem_emissions_update_on_demand_lod2', 'start' ) 1951 ! 1952 !-- Obtain current timestamp and locate index for most recent timestamp element 1953 !-- end subroutine (RETURN) if it is still the same index as the existing time index 2075 1954 2076 1955 this_timestamp = '' ! string must be initiated before using 2077 1956 CALL get_date_time( time_since_reference_point, date_time_str=this_timestamp ) 2078 1957 2079 time_index_location = chem_emissions_locate_timestep & 2080 ( this_timestamp, timestamps, & 2081 1, chem_emis_att%dt_emission ) 1958 time_index_location = chem_emissions_locate_timestep & 1959 ( this_timestamp, timestamps, 1, chem_emis_att%dt_emission ) 2082 1960 2083 1961 IF ( time_index_location == previous_timestamp_index ) RETURN 2084 1962 2085 1963 ! 2086 !-- begin extract emission data for matched species from netCDF file 2087 1964 !-- Begin extract emission data for matched species from netCDF file 2088 1965 previous_timestamp_index = time_index_location 2089 1966 … … 2092 1969 2093 1970 ! 2094 !-- open netCDF file and allocate temp memory 2095 2096 CALL open_read_file( TRIM(input_file_chem) // TRIM(coupling_char), ncid ) 1971 !-- Open netCDF file and allocate temp memory 1972 CALL open_read_file( TRIM( input_file_chem ) // TRIM( coupling_char ), ncid ) 2097 1973 ALLOCATE( emissions_raw(1,1,nys:nyn,nxl:nxr,1) ) 2098 1974 2099 1975 DO k = 1, n_matched_vars 2100 1976 ! 2101 !-- get index for matching species 2102 2103 kmatch = chem_emissions_locate_species ( & 2104 spc_names(match_spec_model(k)), & 2105 chem_emis_att%species_name ) 2106 ! 2107 !-- extract variable as-is 2108 !-- (note C index notations for nx and ny due to MPI and 2109 !-- reversed index dimension order for netCDF Fortran API) 2110 1977 !-- Get index for matching species 1978 kmatch = chem_emissions_locate_species( spc_names(match_spec_model(k)), & 1979 chem_emis_att%species_name ) 1980 ! 1981 !-- Extract variable as-is 1982 !-- Note C index notations for nx and ny due to MPI and reversed index dimension order for netCDF 1983 !-- Fortran API) 2111 1984 emissions_raw = 0.0_wp 2112 1985 2113 CALL get_variable ( ncid, 'emission_values', emissions_raw, &2114 kmatch, nxl+1, nys+1, 1, time_index_location, &1986 CALL get_variable ( ncid, 'emission_values', emissions_raw, & 1987 kmatch, nxl+1, nys+1, 1, time_index_location, & 2115 1988 1, nxr-nxl+1, nyn-nys+1, 1, 1, .FALSE. ) 2116 1989 ! 2117 !-- transfer emission data 2118 1990 !-- Transfer emission data 2119 1991 DO j = nys,nyn 2120 1992 DO i = nxl,nxr … … 2126 1998 ! 2127 1999 !-- netCDF handle and temp memory no longer needed 2128 2129 2000 DEALLOCATE( emissions_raw ) 2130 2001 CALL close_input_file( ncid ) 2131 2002 ! 2132 !-- Set emis_dt since chemistry ODEs can be stiff, the option 2133 !-- to solve them at every RK substep is present to help improve 2134 !-- stability should the need arises 2135 2003 !-- Set emis_dt since chemistry ODEs can be stiff, the option to solve them at every RK substep is 2004 !-- present to help improve stability should the need arise 2136 2005 dt_emis = dt_3d 2137 2006 2138 IF ( call_chem_at_all_substeps ) & 2139 dt_emis = dt_emis * weight_pres(intermediate_timestep_count) 2140 ! 2141 !-- calculate conversion factor from mass flux to molar flux (mixing ratio) 2142 2007 IF ( call_chem_at_all_substeps ) dt_emis = dt_emis * weight_pres(intermediate_timestep_count) 2008 ! 2009 !-- Calculate conversion factor from mass flux to molar flux (mixing ratio) 2143 2010 ALLOCATE ( mass2mole(nys:nyn,nxl:nxr) ) 2144 2011 mass2mole = 0.0_wp … … 2151 2018 2152 2019 ! 2153 !-- calculate surface fluxes 2154 !-- NOTE - For some reason I cannot pass surf_xxx%cssws as output argument 2155 !-- into subroutine assign_surface_flux ( ). The contents got mixed up 2156 !-- once the subroutine is finished. I don't know why and I don't have 2157 !-- time to investigate. As workaround I declared dummy variables 2158 !-- and reassign them one by one (i.e., in a loop) 2020 !-- Calculate surface fluxes 2021 !-- NOTE - For some reason I can not pass surf_xxx%cssws as output argument into subroutine 2022 !-- assign_surface_flux ( ). The contents got mixed up once the subroutine is finished. I 2023 !-- don't know why and I don't have time to investigate. As workaround I declared dummy 2024 !-- variables and reassign them one by one (i.e., in a loop) 2159 2025 !-- ECC 20200206 2160 2026 2161 2027 ! 2162 !-- allocate and initialize dummy surface fluxes 2163 2028 !-- Allocate and initialize dummy surface fluxes 2164 2029 ALLOCATE( cssws_def_h(n_matched_vars,surf_def_h(0)%ns) ) 2165 2030 cssws_def_h = 0.0_wp … … 2172 2037 2173 2038 ! 2174 !-- assign and transfer emissions as surface fluxes 2175 2176 CALL assign_surface_flux ( cssws_def_h, surf_def_h(0)%ns, & 2177 surf_def_h(0)%j, surf_def_h(0)%i, & 2039 !-- Assign and transfer emissions as surface fluxes 2040 CALL assign_surface_flux ( cssws_def_h, surf_def_h(0)%ns, & 2041 surf_def_h(0)%j, surf_def_h(0)%i, & 2178 2042 emis_distrib, mass2mole ) 2179 2043 2180 2044 2181 CALL assign_surface_flux ( cssws_lsm_h, surf_lsm_h%ns, &2182 surf_lsm_h%j, surf_lsm_h%i, &2045 CALL assign_surface_flux ( cssws_lsm_h, surf_lsm_h%ns, & 2046 surf_lsm_h%j, surf_lsm_h%i, & 2183 2047 emis_distrib, mass2mole ) 2184 2048 2185 2049 2186 CALL assign_surface_flux ( cssws_usm_h, surf_usm_h%ns, &2187 surf_usm_h%j, surf_usm_h%i, &2050 CALL assign_surface_flux ( cssws_usm_h, surf_usm_h%ns, & 2051 surf_usm_h%j, surf_usm_h%i, & 2188 2052 emis_distrib, mass2mole ) 2189 2053 … … 2205 2069 2206 2070 ! 2207 !-- cleaning up 2208 2071 !-- Cleaning up 2209 2072 DEALLOCATE( cssws_def_h ) 2210 2073 DEALLOCATE( cssws_lsm_h ) … … 2214 2077 DEALLOCATE ( mass2mole ) 2215 2078 2216 IF ( debug_output ) & 2217 CALL debug_message ( 'chem_emissions_update_on_demand_lod2', 'end' ) 2079 IF ( debug_output ) CALL debug_message ( 'chem_emissions_update_on_demand_lod2', 'end' ) 2218 2080 2219 2081 END SUBROUTINE ! chem_emissions_update_on_demand_lod2 2220 2082 2221 2083 2222 2084 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2223 2085 !! … … 2229 2091 !-- 20200203 (ECC) 2230 2092 ! 2231 !------------------------------------------------------------------------------ !2093 !--------------------------------------------------------------------------------------------------! 2232 2094 ! Description: 2233 2095 ! ------------ 2234 !> look for matched species between emissions attributes and selected2235 !> chemical mechanisms anddetermine corresponding molecular weights2236 !------------------------------------------------------------------------------ !2096 !> Look for matched species between emissions attributes and selected chemical mechanisms and 2097 !> determine corresponding molecular weights 2098 !--------------------------------------------------------------------------------------------------! 2237 2099 2238 2100 SUBROUTINE chem_emissions_init_species ( ncid ) 2239 2101 2240 USE netcdf_data_input_mod, & 2241 ONLY: chem_emis_att, & 2242 open_read_file, close_input_file, & 2243 get_dimension_length, get_variable 2102 USE netcdf_data_input_mod, & 2103 ONLY: chem_emis_att, close_input_file, get_dimension_length, get_variable, open_read_file 2244 2104 2245 2105 IMPLICIT NONE … … 2249 2109 INTEGER(iwp), INTENT(IN) :: ncid !< netcdf file ID 2250 2110 2251 IF ( debug_output ) & 2252 CALL debug_message( 'chem_emissions_init_species', 'start' ) 2253 ! 2254 !- assign species 2255 2111 IF ( debug_output ) CALL debug_message( 'chem_emissions_init_species', 'start' ) 2112 ! 2113 !- Assign species 2256 2114 CALL get_dimension_length ( ncid, chem_emis_att%n_emiss_species, 'nspecies' ) 2257 CALL get_variable ( ncid, 'emission_name', chem_emis_att%species_name, &2258 2259 ! 2260 !- backward compatibility for salsa_mod (ECC)2115 CALL get_variable ( ncid, 'emission_name', chem_emis_att%species_name, & 2116 chem_emis_att%n_emiss_species ) 2117 ! 2118 !- Backward compatibility for salsa_mod (ECC) 2261 2119 chem_emis_att%nspec = chem_emis_att%n_emiss_species 2262 2120 ! 2263 !-- get a list of matched species between emission_attributes and 2264 !-- selected chemical mechanism 2265 2121 !-- Get a list of matched species between emission_attributes and selected chemical mechanism 2266 2122 emission_output_required = .FALSE. 2267 2123 CALL chem_emissions_match( chem_emis_att, n_matched_vars ) 2268 2124 2269 2125 ! 2270 !-- if matched species found (at least 1) 2271 !-- allocate memory for emission attributes 2272 !-- assign molecular masses [kg/mol] 2273 !-- see chemistry_model_mod.f90 for reference 2274 2126 !-- If matched species found (at least 1), 2127 !-- allocate memory for emission attributes, 2128 !-- assign molecular masses [kg/mol], 2129 !-- see chemistry_model_mod.f90 for reference. 2275 2130 IF ( n_matched_vars > 0 ) THEN 2276 2131 … … 2293 2148 END SELECT 2294 2149 ENDDO 2295 2150 2296 2151 ENDIF ! IF ( n_matched_vars > 0 ) 2297 2152 2298 IF ( debug_output ) & 2299 CALL debug_message( 'chem_emissions_init_species', 'end' ) 2153 IF ( debug_output ) CALL debug_message( 'chem_emissions_init_species', 'end' ) 2300 2154 2301 2155 END SUBROUTINE chem_emissions_init_species 2302 2156 2303 2157 2304 2158 ! 2305 2159 !-- 20200203 (ECC) 2306 2160 ! 2307 !------------------------------------------------------------------------------ !2161 !--------------------------------------------------------------------------------------------------! 2308 2162 ! Description: 2309 2163 ! ------------ 2310 !> extract timestamps from netCDF input2311 !------------------------------------------------------------------------------ !2164 !> Extract timestamps from netCDF input 2165 !--------------------------------------------------------------------------------------------------! 2312 2166 2313 2167 SUBROUTINE chem_emissions_init_timestamps ( ncid ) 2314 2168 2315 USE control_parameters, &2169 USE control_parameters, & 2316 2170 ONLY: message_string 2317 2171 2318 USE netcdf_data_input_mod, & 2319 ONLY: chem_emis_att, & 2320 open_read_file, close_input_file, & 2321 get_dimension_length, get_variable 2172 USE netcdf_data_input_mod, & 2173 ONLY: chem_emis_att, close_input_file, get_dimension_length, get_variable, open_read_file 2322 2174 2323 2175 IMPLICIT NONE … … 2328 2180 INTEGER(iwp), INTENT(IN) :: ncid !< netcdf file handle 2329 2181 2330 IF ( debug_output ) & 2331 CALL debug_message( 'chem_emissions_read_timestamps', 'start' ) 2332 ! 2333 !-- import timestamps from netCDF input 2334 2182 IF ( debug_output ) CALL debug_message( 'chem_emissions_read_timestamps', 'start' ) 2183 ! 2184 !-- Import timestamps from netCDF input 2335 2185 CALL get_dimension_length ( ncid, chem_emis_att%dt_emission, 'time' ) 2336 2186 CALL get_dimension_length ( ncid, fld_len, 'field_length' ) 2337 2187 CALL get_variable ( ncid, 'timestamp', timestamps, chem_emis_att%dt_emission, fld_len ) 2338 2188 ! 2339 !-- throw error at first instance of timestamps 2340 !-- not in listed in chronological order 2341 2189 !-- Throw error at first instance of timestamps not in listed in chronological order. 2342 2190 DO itime = 2,chem_emis_att%dt_emission 2343 2191 2344 2192 IF ( timestamps(itime-1) > timestamps(itime) ) THEN 2345 2193 2346 WRITE( message_string, * ) &2347 'input timestamps not in chronological order for',&2348 CHAR(10), ' ',&2349 'index ', (itime-1), ' : ', TRIM(timestamps(itime-1)), ' and',&2350 CHAR(10), ' ',&2351 'index ', (itime), ' : ', TRIM(timestamps(itime))2194 WRITE( message_string, * ) & 2195 'input timestamps not in chronological order for', & 2196 CHAR( 10 ), ' ', & 2197 'index ', (itime-1), ' : ', TRIM( timestamps(itime-1) ), ' and', & 2198 CHAR( 10 ), ' ', & 2199 'index ', (itime), ' : ', TRIM( timestamps(itime) ) 2352 2200 2353 2201 CALL message( 'chem_emissions_read_timestamps', 'CM0469', 1, 2, 0, 6, 0 ) … … 2357 2205 ENDDO 2358 2206 2359 IF ( debug_output ) & 2360 CALL debug_message( 'chem_emissions_read_timestamps', 'end' ) 2207 IF ( debug_output ) CALL debug_message( 'chem_emissions_read_timestamps', 'end' ) 2361 2208 2362 2209 END SUBROUTINE chem_emissions_init_timestamps … … 2366 2213 !-- 20200203 (ECC) 2367 2214 ! 2368 !------------------------------------------------------------------------------ !2215 !--------------------------------------------------------------------------------------------------! 2369 2216 ! Description: 2370 2217 ! ------------ 2371 !> assign emissions as surface fluxes 2372 ! 2373 !> NOTE: For arguments, I originally wanted to use unspecified dimensions, 2374 !> but I could not get this to work properly, hence the dimensioned 2375 !> array arguments 2376 !------------------------------------------------------------------------------! 2377 2378 SUBROUTINE assign_surface_flux ( surf_array, nsurfs, surf_j, surf_i, & 2379 emis_dist, conv_mole ) 2380 2381 USE arrays_3d, & 2218 !> Assign emissions as surface fluxes 2219 ! 2220 !> NOTE: For arguments, I originally wanted to use unspecified dimensions, but I could not get 2221 !> this to work properly, hence the dimensioned array arguments. 2222 !--------------------------------------------------------------------------------------------------! 2223 2224 SUBROUTINE assign_surface_flux ( surf_array, nsurfs, surf_j, surf_i, emis_dist, conv_mole ) 2225 2226 USE arrays_3d, & 2382 2227 ONLY: rho_air 2383 2228 2384 USE netcdf_data_input_mod, &2229 USE netcdf_data_input_mod, & 2385 2230 ONLY: chem_emis_att 2386 2231 … … 2389 2234 IMPLICIT NONE 2390 2235 ! 2391 !-- input arguments 2392 2236 !-- Input arguments 2393 2237 INTEGER(iwp), INTENT(IN) :: nsurfs !< # surfaces in surf_array 2238 2394 2239 INTEGER(iwp), DIMENSION(nsurfs), INTENT(IN) :: surf_i !< i indices 4 surf. elements 2395 2240 INTEGER(iwp), DIMENSION(nsurfs), INTENT(IN) :: surf_j !< j indices 4 surf. elements … … 2401 2246 2402 2247 ! 2403 !-- parameters (magic numbers) 2404 2248 !-- Parameters (magic numbers) 2405 2249 CHARACTER(LEN=2), PARAMETER :: sp_PM = 'PM' !< id string for all PMs 2406 2250 CHARACTER(LEN=3), PARAMETER :: sp_VOC = 'VOC' !< id string for VOC … … 2408 2252 REAL(wp), PARAMETER :: mol2ppm = 1.0E+06_wp !< conversion from mole 2 ppm 2409 2253 ! 2410 !-- local variables 2411 2254 !-- Local variables 2412 2255 CHARACTER(LEN=80) :: this_species_name !< matched species name 2413 2256 … … 2416 2259 REAL(wp) :: flux_conv_factor !< conversion factor 2417 2260 2418 IF ( debug_output ) & 2419 CALL debug_message( 'chem_emissions_header_init_lod2', 'start' ) 2261 IF ( debug_output ) CALL debug_message( 'chem_emissions_header_init_lod2', 'start' ) 2420 2262 2421 2263 DO k = 1, n_matched_vars … … 2429 2271 2430 2272 ! 2431 !-- calculate conversion factor depending on emission species type 2432 2273 !-- Calculate conversion factor depending on emission species type 2433 2274 flux_conv_factor = rho_air(nzb) 2434 2275 ! 2435 !-- account for conversion to different types of emisison species 2436 2437 IF ( TRIM(this_species_name(1:LEN(sp_PM))) == sp_PM ) THEN 2276 !-- Account for conversion to different types of emisison species 2277 IF ( TRIM( this_species_name( 1:LEN( sp_PM ) ) ) == sp_PM ) THEN 2438 2278 2439 2279 ! do nothing (use mass flux directly) 2440 2280 2441 ELSE IF ( TRIM(this_species_name(1:LEN(sp_VOC))) == sp_VOC ) THEN 2442 2443 flux_conv_factor = flux_conv_factor * & 2444 conv_mole(j,i) * mol2ppm 2281 ELSE IF ( TRIM( this_species_name( 1:LEN( sp_VOC ) ) ) == sp_VOC ) THEN 2282 2283 flux_conv_factor = flux_conv_factor * conv_mole(j,i) * mol2ppm 2445 2284 2446 2285 ELSE 2447 2286 2448 flux_conv_factor = flux_conv_factor * & 2449 conv_mole(j,i) * mol2ppm / & 2450 chem_emis_att%xm(k) 2287 flux_conv_factor = flux_conv_factor * conv_mole(j,i) * mol2ppm / chem_emis_att%xm(k) 2451 2288 2452 2289 ENDIF 2453 2290 ! 2454 !-- finally assign surface flux 2455 2291 !-- Finally assign surface flux 2456 2292 surf_array(k,m) = emis_dist(k,j,i) * flux_conv_factor 2457 2293 … … 2461 2297 2462 2298 2463 IF ( debug_output ) & 2464 CALL debug_message( 'chem_emissions_header_init_lod2', 'end' ) 2465 2299 IF ( debug_output ) CALL debug_message( 'chem_emissions_header_init_lod2', 'end' ) 2300 2466 2301 END SUBROUTINE assign_surface_flux 2467 2302 2468 2303 2469 2304 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2470 2305 !! … … 2476 2311 !-- 20200203 (ECC) 2477 2312 ! 2478 !------------------------------------------------------------------------------ !2313 !--------------------------------------------------------------------------------------------------! 2479 2314 ! Description: 2480 2315 ! ------------ 2481 !> given incoming flux units ( mass / area / time ) provide single-valued2482 !> conversion factor to( kg / m2 / s )2483 !------------------------------------------------------------------------------ !2316 !> Given incoming flux units ( mass / area / time ) provide single-valued onversion factor to 2317 !> ( kg / m2 / s ) 2318 !--------------------------------------------------------------------------------------------------! 2484 2319 2485 2320 FUNCTION chem_emissions_convert_base_units ( units_in ) RESULT ( conv_factor ) … … 2487 2322 IMPLICIT NONE 2488 2323 ! 2489 !-- function arguments 2324 !-- Function arguments 2325 CHARACTER(LEN=*), INTENT(IN) :: units_in !< incoming units (ie emt_att%units) 2490 2326 2491 2327 REAL(wp) :: conv_factor !< convertion factor 2492 2328 2493 CHARACTER(LEN=*), INTENT(IN) :: units_in !< incoming units (ie emt_att%units) 2494 ! 2495 !-- parameters (magic numbers) 2496 2329 ! 2330 !-- Parameters (magic numbers) 2497 2331 INTEGER(iwp), PARAMETER :: up2lo = 32 !< convert letter to lower case 2498 2332 ! 2499 !-- base unit conversion factors (should be self-explanatory)2500 2333 !-- Base unit conversion factors (should be self-explanatory) 2334 REAL(wp), PARAMETER :: hour_per_year = 8760.0_wp 2501 2335 REAL(wp), PARAMETER :: g_to_kg = 1.0E-03_wp 2502 2336 REAL(wp), PARAMETER :: miug_to_kg = 1.0E-09_wp 2503 REAL(wp), PARAMETER :: tons_to_kg = 100.0_wp2504 2505 REAL(wp), PARAMETER :: hour_per_year = 8760.0_wp2506 2337 REAL(wp), PARAMETER :: s_per_hour = 3600.0_wp 2507 2338 REAL(wp), PARAMETER :: s_per_day = 86400.0_wp 2339 REAL(wp), PARAMETER :: tons_to_kg = 100.0_wp 2508 2340 2509 2341 REAL(wp), PARAMETER :: day_to_s = 1.0_wp / s_per_day 2510 2342 REAL(wp), PARAMETER :: hour_to_s = 1.0_wp / s_per_hour 2511 REAL(wp), PARAMETER :: year_to_s = 1.0_wp / s_per_hour / hour_per_year 2512 ! 2513 !-- local variables 2514 2343 REAL(wp), PARAMETER :: year_to_s = 1.0_wp / s_per_hour / hour_per_year 2344 2345 2346 ! 2347 !-- Local variables 2515 2348 CHARACTER(LEN=LEN(units_in)) :: units_in_lo !< units in lower case 2516 2349 … … 2518 2351 INTEGER(iwp) :: str_len !< length of unit string 2519 2352 ! 2520 !-- turn units string to lower case 2521 2353 !-- Turn units string to lower case 2522 2354 units_in_lo = '' 2523 str_len = LEN( TRIM(units_in))2355 str_len = LEN( TRIM( units_in ) ) 2524 2356 2525 2357 DO k = 1,str_len 2526 2358 j = IACHAR( units_in(k:k) ) 2527 units_in_lo(k:k) = ACHAR( j)2528 IF ( ( j>=IACHAR("A")) .AND. (j<=IACHAR("Z")) )&2529 units_in_lo(k:k) = ACHAR 2359 units_in_lo(k:k) = ACHAR( j ) 2360 IF ( ( j >= IACHAR( "A" ) ) .AND. ( j <= IACHAR( "Z" ) ) ) & 2361 units_in_lo(k:k) = ACHAR( j + up2lo ) 2530 2362 ENDDO 2531 2363 … … 2551 2383 CASE DEFAULT 2552 2384 message_string = '' ! to get around unused variable warning / error 2553 WRITE ( message_string, * ) 'Specified emission units (', & 2554 TRIM(units_in), & 2385 WRITE ( message_string, * ) 'Specified emission units (', TRIM( units_in ), & 2555 2386 ') not recognized in PALM-4U' 2556 2387 CALL message ( 'chem_emission_convert_units', 'CM0446', 2, 2, 0, 6, 0 ) … … 2563 2394 !-- 20200203 (ECC) 2564 2395 ! 2565 !------------------------------------------------------------------------------ !2396 !--------------------------------------------------------------------------------------------------! 2566 2397 ! Description: 2567 2398 ! ------------ 2568 !> calculates conversion factor from mass flux to ppm (molar flux)2569 !------------------------------------------------------------------------------ !2399 !> Calculates conversion factor from mass flux to ppm (molar flux) 2400 !--------------------------------------------------------------------------------------------------! 2570 2401 2571 2402 FUNCTION mass_2_molar_flux ( rhogh, theta ) RESULT ( conv_factor ) 2572 2403 2573 USE basic_constants_and_equations_mod, &2574 ONLY: p_0, r gas_univ, rd_d_cp2404 USE basic_constants_and_equations_mod, & 2405 ONLY: p_0, rd_d_cp, rgas_univ 2575 2406 2576 2407 IMPLICIT NONE 2577 2408 ! 2578 !-- function arguments 2579 2409 !-- Function arguments 2580 2410 REAL(wp) :: conv_factor !< conversion factor 2581 2411 REAL(wp), INTENT(IN) :: rhogh !< hydrostatic pressure … … 2590 2420 !-- 20200203 (ECC) 2591 2421 ! 2592 !------------------------------------------------------------------------------ !2422 !--------------------------------------------------------------------------------------------------! 2593 2423 ! Description: 2594 2424 ! ------------ 2595 !> given target sepecies locate index in species array2425 !> Given target sepecies locate index in species array 2596 2426 !> returns 0 if none is found 2597 !------------------------------------------------------------------------------! 2598 2599 FUNCTION chem_emissions_locate_species ( this_species, species_array ) & 2600 RESULT ( species_index ) 2427 !--------------------------------------------------------------------------------------------------! 2428 2429 FUNCTION chem_emissions_locate_species ( this_species, species_array ) RESULT ( species_index ) 2601 2430 2602 2431 IMPLICIT NONE 2603 2432 ! 2604 !-- function arguments 2605 2433 !-- Function arguments 2606 2434 INTEGER(iwp) :: species_index !> index matching species 2607 2435 2436 CHARACTER(LEN=25), INTENT(IN) :: species_array(:) !> array of species 2608 2437 CHARACTER(LEN=*), INTENT(IN) :: this_species !> target species 2609 CHARACTER(LEN=25), INTENT(IN) :: species_array(:) !> array of species 2610 ! 2611 !-- local variables 2612 2438 ! 2439 !-- Local variables 2613 2440 INTEGER(iwp) :: k !> generic counter 2614 2441 INTEGER(iwp) :: n_species !> number of species in species_array … … 2617 2444 2618 2445 DO k = 1, n_species 2619 IF ( TRIM( species_array(k)) == TRIM(this_species) ) EXIT2446 IF ( TRIM( species_array(k) ) == TRIM( this_species ) ) EXIT 2620 2447 ENDDO 2621 2448 2622 2449 species_index = 0 !> assume no matching index is found 2623 2450 2624 IF ( TRIM( species_array(k)) == TRIM(this_species) ) specieS_index = k2451 IF ( TRIM( species_array(k) ) == TRIM( this_species ) ) specieS_index = k 2625 2452 2626 2453 END FUNCTION chem_emissions_locate_species … … 2630 2457 !-- 20200203 (ECC) 2631 2458 ! 2632 !------------------------------------------------------------------------------ !2459 !--------------------------------------------------------------------------------------------------! 2633 2460 ! Description: 2634 2461 ! ------------ 2635 2462 !> given target timestamp locate most recent timestep in timestamp array 2636 2463 !> using bisection search (since array is sorted) 2637 !------------------------------------------------------------------------------! 2638 2639 RECURSIVE FUNCTION chem_emissions_locate_timestep & 2640 ( this_timestamp, timestamp_array, & 2641 lower_bound, upper_bound ) & 2464 !--------------------------------------------------------------------------------------------------! 2465 2466 RECURSIVE FUNCTION chem_emissions_locate_timestep & 2467 ( this_timestamp, timestamp_array, lower_bound, upper_bound ) & 2642 2468 RESULT ( timestamp_index ) 2643 2469 2644 2470 ! 2645 !-- function arguments 2646 2647 INTEGER(iwp) :: timestamp_index !> index for most recent timestamp in timestamp_array 2648 2471 !-- Function arguments 2649 2472 CHARACTER(LEN=*), INTENT(IN) :: this_timestamp !> target timestamp 2650 2473 CHARACTER(LEN=512), INTENT(IN) :: timestamp_array(:) !> array of timestamps … … 2652 2475 INTEGER(iwp), INTENT(IN) :: lower_bound, upper_bound !> timestamp_array index bounds 2653 2476 2654 ! 2655 !-- local variables 2656 2477 INTEGER(iwp) :: timestamp_index !> index for most recent timestamp in timestamp_array 2478 2479 ! 2480 !-- Local variables 2657 2481 INTEGER(iwp) :: k0,km,k1 !> lower, central, and upper index bounds 2658 2482 ! 2659 !-- assign bounds 2660 2483 !-- Assign bounds 2661 2484 k0 = lower_bound 2662 2485 k1 = upper_bound 2663 2486 ! 2664 !-- make sure k1 is always not smaller than k0 2665 2487 !-- Make sure k1 is always not smaller than k0 2666 2488 IF ( k0 > k1 ) THEN 2667 2489 k0 = upper_bound … … 2669 2491 ENDIF 2670 2492 ! 2671 !-- make sure k0 and k1 stay within array bounds by timestamp_array 2672 2493 !-- Make sure k0 and k1 stay within array bounds by timestamp_array 2673 2494 IF ( k0 < 1 ) k0 = 1 2674 IF ( k1 > SIZE(timestamp_array,1) ) k1 = SIZE(timestamp_array,1) 2675 ! 2676 !-- terminate if target is contained within 2 consecutive indices 2677 !-- otherwise calculate central bound (km) and determine new 2678 !-- index bounds for the next iteration 2495 IF ( k1 > SIZE( timestamp_array, 1 ) ) k1 = SIZE( timestamp_array, 1 ) 2496 ! 2497 !-- Terminate if target is contained within 2 consecutive indices otherwise calculate central bound 2498 !-- (km) and determine new index bounds for the next iteration 2679 2499 2680 2500 IF ( ( k1 - k0 ) > 1 ) THEN 2681 2501 km = ( k0 + k1 ) / 2 2682 IF ( TRIM( this_timestamp) > TRIM(timestamp_array(km)) ) THEN2502 IF ( TRIM( this_timestamp ) > TRIM( timestamp_array(km) ) ) THEN 2683 2503 k0 = km 2684 2504 ELSE 2685 2505 k1 = km 2686 2506 ENDIF 2687 timestamp_index = chem_emissions_locate_timestep & 2688 ( this_timestamp, timestamp_array, k0, k1 ) 2507 timestamp_index = chem_emissions_locate_timestep( this_timestamp, timestamp_array, k0, k1 ) 2689 2508 ELSE 2690 2509 timestamp_index = k0
Note: See TracChangeset
for help on using the changeset viewer.
