Changeset 4270 for palm/trunk/SOURCE/salsa_mod.f90
- Timestamp:
- Oct 23, 2019 10:46:20 AM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/salsa_mod.f90 (modified) (55 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/salsa_mod.f90
r4268 r4270 26 26 ! ----------------- 27 27 ! $Id$ 28 ! - Implement offline nesting for salsa 29 ! - Alphabetic ordering for module interfaces 30 ! - Remove init_aerosol_type and init_gases_type from salsa_parin and define them 31 ! based on the initializing_actions 32 ! - parameter definition removed from "season" and "season_z01" is added to parin 33 ! - bugfix in application of index_hh after implementing the new 34 ! palm_date_time_mod 35 ! - Reformat salsa emission data with LOD=2: size distribution given for each 36 ! emission category 37 ! 38 ! 4268 2019-10-17 11:29:38Z schwenkel 28 39 ! Moving module specific boundary conditions from time_integration to module 29 40 ! … … 31 42 ! Document previous changes: use global variables nx, ny and nz in salsa_header 32 43 ! 33 ! 42 55 2019-10-04 11:50:55Z monakurppa44 ! 4227 2019-09-10 18:04:34Z gronemeier 34 45 ! implement new palm_date_time_mod 35 46 ! … … 241 252 !< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV 242 253 !< (non-volatile OC), 5 = OCSV (semi-volatile) 243 INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising the aerosol size 244 !< distribution 254 INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising the aerosol size distribution 245 255 INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges 246 256 INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species 247 INTEGER(iwp), PARAMETER :: season = 1 !< For dry depostion by Zhang et al.: 1 = summer, 248 !< 2 = autumn (no harvest yet), 3 = late autumn 249 !< (already frost), 4 = winter, 5 = transitional spring 257 250 258 251 259 REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute … … 253 261 !-- Universal constants 254 262 REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K) 255 REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O 256 !< vaporisation (J/kg) 263 REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O vaporisation (J/kg) 257 264 REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv 258 REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of one air 259 !< molecule (Jacobson, 260 !< 2005, Eq. 2.3) 265 REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of an air molecule (Jacobson 2005, Eq.2.3) 261 266 REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6 262 267 REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K)) 263 268 REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd 264 269 REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol) 265 REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of condensing sulphuric 266 !< acid molecule (m) 270 REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of condensing H2SO4 molecule (m) 267 271 REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3)) 268 REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic 269 !< material 272 REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic material 270 273 REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min limit (kg/m3) 271 REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in 3 nm cluster 272 !< if d_sa=5.54e-10m 274 REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in 3 nm cluster if d_sa=5.54e-10m 273 275 REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit (#/m3) 274 276 REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of water at 293 K (J/m2) … … 377 379 INTEGER(iwp) :: depo_pcm_type_num = 0 !< index for the dry deposition type on the plant canopy 378 380 INTEGER(iwp) :: depo_surf_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010 379 INTEGER(iwp) :: dots_salsa = 0 !< starting index for salsa-timeseries380 381 INTEGER(iwp) :: end_subrange_1a = 1 !< last index for bin subrange 1a 381 382 INTEGER(iwp) :: end_subrange_2a = 1 !< last index for bin subrange 2a … … 392 393 INTEGER(iwp) :: init_aerosol_type = 0 !< Initial size distribution type 393 394 !< 0 = uniform (read from PARIN) 394 !< 1 = read vertical profile of the mode number 395 !< concentration from an input file 395 !< 1 = read vertical profiles from an input file 396 396 INTEGER(iwp) :: init_gases_type = 0 !< Initial gas concentration type 397 397 !< 0 = uniform (read from PARIN) 398 !< 1 = read vertical profile from an input file398 !< 1 = read vertical profiles from an input file 399 399 INTEGER(iwp) :: lod_gas_emissions = 0 !< level of detail of the gaseous emission data 400 INTEGER(iwp) :: main_street_id = 0 !< lower bound of main street IDs (OpenStreetMaps) for parameterizedmode401 INTEGER(iwp) :: max_street_id = 0 !< upper bound of main street IDs (OpenStreetMaps) for parameterizedmode400 INTEGER(iwp) :: main_street_id = 0 !< lower bound of main street IDs for parameterized emission mode 401 INTEGER(iwp) :: max_street_id = 0 !< upper bound of main street IDs for parameterized emission mode 402 402 INTEGER(iwp) :: nbins_aerosol = 1 !< total number of size bins 403 403 INTEGER(iwp) :: ncc = 1 !< number of chemical components used … … 422 422 !< + heteromolecular nucleation with H2SO4*ORG 423 423 INTEGER(iwp) :: salsa_pr_count = 0 !< counter for salsa variable profiles 424 INTEGER(iwp) :: side_street_id = 0 !< lower bound of side street IDs (OpenStreetMaps) for parameterized mode 424 INTEGER(iwp) :: season_z01 = 1 !< For dry deposition by Zhang et al.: 1 = summer, 425 !< 2 = autumn (no harvest yet), 3 = late autumn 426 !< (already frost), 4 = winter, 5 = transitional spring 427 INTEGER(iwp) :: side_street_id = 0 !< lower bound of side street IDs for parameterized emission mode 425 428 INTEGER(iwp) :: start_subrange_1a = 1 !< start index for bin subranges: subrange 1a 426 429 INTEGER(iwp) :: start_subrange_2a = 1 !< subrange 2a … … 448 451 LOGICAL :: feedback_to_palm = .FALSE. !< Allow feedback due to condensation of H2O 449 452 LOGICAL :: nest_salsa = .FALSE. !< Apply nesting for salsa 453 LOGICAL :: nesting_offline_salsa = .FALSE. !< Apply offline nesting for salsa 450 454 LOGICAL :: no_insoluble = .FALSE. !< Exclude insoluble chemical components 451 455 LOGICAL :: read_restart_data_salsa = .FALSE. !< Read restart data for salsa 452 LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous components to SALSA from 453 !< the chemistry model 454 LOGICAL :: van_der_waals_coagc = .FALSE. !< Enhancement of coagulation kernel by van der 455 !< Waals and viscous forces 456 LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous components to SALSA 457 LOGICAL :: van_der_waals_coagc = .FALSE. !< Include van der Waals and viscous forces in coagulation 456 458 LOGICAL :: write_binary_salsa = .FALSE. !< read binary for salsa 457 459 ! … … 491 493 REAL(wp) :: ocsv_init = nclim !< Init value for semi-volatile organic gases 492 494 REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents unrealistical RH 495 REAL(wp) :: time_utc_init !< time in seconds-of-day of origin_date_time 493 496 REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s) 494 497 ! … … 503 506 ! 504 507 !-- Initial mass fractions / chemical composition of the size distribution 505 REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between506 (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins507 REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between508 (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins509 REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges508 REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between 509 (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins 510 REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between 511 (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins 512 REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges 510 513 (/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/) 511 514 ! … … 628 631 REAL(wp) :: fill !< fill value 629 632 630 REAL(wp), DIMENSION(:), ALLOCATABLE :: preproc_mass_fracs !< mass fractions 631 632 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: def_mass_fracs !< mass fractions per emis. category 633 634 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data !< surface emission values in PM 635 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data !< surface emission values per bin 633 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mass_fracs !< mass fractions per emis. category 634 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: num_fracs !< number fractions per emis. category 635 636 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data !< surface emission in PM 637 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data !< surface emission per category 636 638 637 639 END TYPE salsa_emission_value_type 640 ! 641 !-- Offline nesting data type 642 TYPE salsa_nest_offl_type 643 644 CHARACTER(LEN=16) :: char_l = 'ls_forcing_left_' !< leading substring at left boundary 645 CHARACTER(LEN=17) :: char_n = 'ls_forcing_north_' !< leading substring at north boundary 646 CHARACTER(LEN=17) :: char_r = 'ls_forcing_right_' !< leading substring at right boundary 647 CHARACTER(LEN=17) :: char_s = 'ls_forcing_south_' !< leading substring at south boundary 648 CHARACTER(LEN=15) :: char_t = 'ls_forcing_top_' !< leading substring at top boundary 649 650 CHARACTER(LEN=5), DIMENSION(1:ngases_salsa) :: gas_name = (/'h2so4','hno3 ','nh3 ','ocnv ','ocsv '/) 651 652 CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name 653 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< list of variable names 654 655 INTEGER(iwp) :: id_dynamic !< NetCDF id of dynamic input file 656 INTEGER(iwp) :: ncc !< number of aerosol chemical components 657 INTEGER(iwp) :: nt !< number of time levels in dynamic input file 658 INTEGER(iwp) :: nzu !< number of vertical levels on scalar grid in dynamic input file 659 INTEGER(iwp) :: tind !< time index for reference time in mesoscale-offline nesting 660 INTEGER(iwp) :: tind_p !< time index for following time in mesoscale-offline nesting 661 662 INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod = 0 !< to transfer chemical composition from input to model 663 664 LOGICAL :: init = .FALSE. !< flag indicating the initialisation of offline nesting 665 666 REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< vertical profile of aerosol bin diameters 667 REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time in dynamic input file 668 REAL(wp), DIMENSION(:), ALLOCATABLE :: zu_atmos !< zu in dynamic input file 669 670 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_left !< gas conc. at left boundary 671 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_north !< gas conc. at north boundary 672 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_right !< gas conc. at right boundary 673 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_south !< gas conc. at south boundary 674 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_top !< gas conc.at top boundary 675 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_left !< aerosol mass conc. at left boundary 676 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_north !< aerosol mass conc. at north boundary 677 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_right !< aerosol mass conc. at right boundary 678 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_south !< aerosol mass conc. at south boundary 679 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_top !< aerosol mass conc. at top boundary 680 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_left !< aerosol number conc. at left boundary 681 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_north !< aerosol number conc. at north boundary 682 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_right !< aerosol number conc. at right boundary 683 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_south !< aerosol number conc. at south boundary 684 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_top !< aerosol number conc. at top boundary 685 686 END TYPE salsa_nest_offl_type 638 687 ! 639 688 !-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration) … … 728 777 !< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O 729 778 ! 779 !-- Offline nesting: 780 TYPE(salsa_nest_offl_type) :: salsa_nest_offl !< data structure for offline nesting 781 ! 730 782 !-- Data output arrays: 731 783 ! … … 808 860 END INTERFACE salsa_define_netcdf_grid 809 861 810 INTERFACE salsa_driver811 MODULE PROCEDURE salsa_driver812 END INTERFACE salsa_driver813 814 862 INTERFACE salsa_emission_update 815 863 MODULE PROCEDURE salsa_emission_update … … 831 879 MODULE PROCEDURE salsa_init_arrays 832 880 END INTERFACE salsa_init_arrays 881 882 INTERFACE salsa_nesting_offl_bc 883 MODULE PROCEDURE salsa_nesting_offl_bc 884 END INTERFACE salsa_nesting_offl_bc 885 886 INTERFACE salsa_nesting_offl_init 887 MODULE PROCEDURE salsa_nesting_offl_init 888 END INTERFACE salsa_nesting_offl_init 889 890 INTERFACE salsa_nesting_offl_input 891 MODULE PROCEDURE salsa_nesting_offl_input 892 END INTERFACE salsa_nesting_offl_input 833 893 834 894 INTERFACE salsa_non_advective_processes … … 873 933 ! 874 934 !-- Public functions: 875 PUBLIC salsa_boundary_conds, salsa_check_data_output, salsa_check_parameters, salsa_boundary_conditions, & 876 salsa_3d_data_averaging, salsa_data_output_2d, salsa_data_output_3d, & 877 salsa_data_output_mask, salsa_define_netcdf_grid, salsa_diagnostics, salsa_driver, & 878 salsa_emission_update, salsa_header, salsa_init, salsa_init_arrays, salsa_parin, & 879 salsa_rrd_local, salsa_swap_timelevel, salsa_prognostic_equations, salsa_wrd_local, & 880 salsa_actions, salsa_non_advective_processes, salsa_exchange_horiz_bounds, & 881 salsa_check_data_output_pr, salsa_statistics 935 PUBLIC salsa_3d_data_averaging, & 936 salsa_actions, & 937 salsa_boundary_conds, & 938 salsa_boundary_conditions, & 939 salsa_check_data_output, & 940 salsa_check_data_output_pr, & 941 salsa_check_parameters, & 942 salsa_data_output_2d, & 943 salsa_data_output_3d, & 944 salsa_data_output_mask, & 945 salsa_define_netcdf_grid, & 946 salsa_diagnostics, & 947 salsa_emission_update, & 948 salsa_exchange_horiz_bounds, & 949 salsa_header, & 950 salsa_init, & 951 salsa_init_arrays, & 952 salsa_nesting_offl_bc, & 953 salsa_nesting_offl_init, & 954 salsa_nesting_offl_input, & 955 salsa_non_advective_processes, & 956 salsa_parin, & 957 salsa_prognostic_equations, & 958 salsa_rrd_local, & 959 salsa_statistics, & 960 salsa_swap_timelevel, & 961 salsa_wrd_local 962 882 963 ! 883 964 !-- Public parameters, constants and initial values 884 PUBLIC bc_am_t_val, bc_an_t_val, bc_gt_t_val, dots_salsa, dt_salsa, & 885 ibc_salsa_b, last_salsa_time, lsdepo, nest_salsa, salsa, salsa_gases_from_chem, & 965 PUBLIC bc_am_t_val, & 966 bc_an_t_val, & 967 bc_gt_t_val, & 968 ibc_salsa_b, & 969 init_aerosol_type, & 970 init_gases_type, & 971 nest_salsa, & 972 nesting_offline_salsa, & 973 salsa_gases_from_chem, & 886 974 skip_time_do_salsa 887 975 ! 888 !-- Public prognostic variables 889 PUBLIC aerosol_mass, aerosol_number, gconc_2, mconc_2, nbins_aerosol, ncc, ncomponents_mass, & 890 nclim, nconc_2, ngases_salsa, prtcl, ra_dry, salsa_gas, sedim_vd 976 !-- Public variables 977 PUBLIC aerosol_mass, & 978 aerosol_number, & 979 gconc_2, & 980 mconc_2, & 981 nbins_aerosol, & 982 ncomponents_mass, & 983 nconc_2, & 984 ngases_salsa, & 985 salsa_gas, & 986 salsa_nest_offl 891 987 892 988 … … 930 1026 h2so4_init, & 931 1027 hno3_init, & 932 init_gases_type, &933 init_aerosol_type, &934 1028 listspec, & 935 1029 main_street_id, & … … 940 1034 nbin, & 941 1035 nest_salsa, & 1036 nesting_offline_salsa, & 942 1037 nf2a, & 943 1038 nh3_init, & … … 958 1053 salsa, & 959 1054 salsa_emission_mode, & 1055 season_z01, & 960 1056 sigmag, & 961 1057 side_street_id, & … … 1002 1098 1003 1099 USE control_parameters, & 1004 ONLY: humidity 1100 ONLY: humidity, initializing_actions 1005 1101 1006 1102 IMPLICIT NONE 1007 1103 1008 1104 ! 1009 !-- Check s go here (cf. check_parameters.f90).1105 !-- Check that humidity is switched on 1010 1106 IF ( salsa .AND. .NOT. humidity ) THEN 1011 1107 WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity 1012 1108 CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 ) 1013 1109 ENDIF 1014 1110 ! 1111 !-- Set bottom boundary condition flag 1015 1112 IF ( bc_salsa_b == 'dirichlet' ) THEN 1016 1113 ibc_salsa_b = 0 … … 1021 1118 CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 ) 1022 1119 ENDIF 1023 1120 ! 1121 !-- Set top boundary conditions flag 1024 1122 IF ( bc_salsa_t == 'dirichlet' ) THEN 1025 1123 ibc_salsa_t = 0 … … 1032 1130 CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 ) 1033 1131 ENDIF 1034 1132 ! 1133 !-- If nest_salsa = .F., set top boundary to dirichlet 1134 IF ( .NOT. nest_salsa .AND. ibc_salsa_t == 2 ) THEN 1135 ibc_salsa_t = 0 1136 bc_salsa_t = 'dirichlet' 1137 ENDIF 1138 ! 1139 !-- Check J3 parametrisation 1035 1140 IF ( nj3 < 1 .OR. nj3 > 3 ) THEN 1036 1141 message_string = 'unknown nj3 (must be 1-3)' 1037 1142 CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 ) 1038 1143 ENDIF 1039 1144 ! 1145 !-- Check bottom boundary condition in case of surface emissions 1040 1146 IF ( salsa_emission_mode /= 'no_emission' .AND. ibc_salsa_b == 0 ) THEN 1041 1147 message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"' 1042 1148 CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 ) 1043 1149 ENDIF 1044 1150 ! 1151 !-- Check whether emissions are applied 1045 1152 IF ( salsa_emission_mode /= 'no_emission' ) include_emission = .TRUE. 1153 ! 1154 !-- Set the initialisation type: background concentration are read from PIDS_DYNAMIC if 1155 !-- initializing_actions = 'inifor set_constant_profiles' 1156 IF ( INDEX( initializing_actions, 'inifor' ) /= 0 ) THEN 1157 init_aerosol_type = 1 1158 init_gases_type = 1 1159 ENDIF 1046 1160 1047 1161 END SUBROUTINE salsa_check_parameters … … 3751 3865 alpha = alpha_z01(depo_pcm_type_num) 3752 3866 gamma = gamma_z01(depo_pcm_type_num) 3753 par_a = A_z01(depo_pcm_type_num, season ) * 1.0E-3_wp3867 par_a = A_z01(depo_pcm_type_num, season_z01) * 1.0E-3_wp 3754 3868 ! 3755 3869 !-- Deposition efficiencies from Table 1. Constants from Table 2. … … 3992 4106 alpha = alpha_z01(luc_urban) 3993 4107 gamma = gamma_z01(luc_urban) 3994 par_a = A_z01(luc_urban, season ) * 1.0E-3_wp4108 par_a = A_z01(luc_urban, season_z01) * 1.0E-3_wp 3995 4109 3996 4110 par_l = l_p10(luc_urban) * 0.01_wp … … 4014 4128 alpha = alpha_z01( match_array%match_lupg(m) ) 4015 4129 gamma = gamma_z01( match_array%match_lupg(m) ) 4016 par_a = A_z01( match_array%match_lupg(m), season ) * 1.0E-3_wp4130 par_a = A_z01( match_array%match_lupg(m), season_z01 ) * 1.0E-3_wp 4017 4131 4018 4132 beta_im = beta_im_p10( match_array%match_lupg(m) ) … … 4045 4159 alpha = alpha_z01( match_array%match_luvw(m) ) 4046 4160 gamma = gamma_z01( match_array%match_luvw(m) ) 4047 par_a = A_z01( match_array%match_luvw(m), season ) * 1.0E-3_wp4161 par_a = A_z01( match_array%match_luvw(m), season_z01 ) * 1.0E-3_wp 4048 4162 4049 4163 beta_im = beta_im_p10( match_array%match_luvw(m) ) … … 4076 4190 alpha = alpha_z01( match_array%match_luww(m) ) 4077 4191 gamma = gamma_z01( match_array%match_luww(m) ) 4078 par_a = A_z01( match_array%match_luww(m), season ) * 1.0E-3_wp4192 par_a = A_z01( match_array%match_luww(m), season_z01 ) * 1.0E-3_wp 4079 4193 4080 4194 beta_im = beta_im_p10( match_array%match_luww(m) ) … … 8215 8329 SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init ) 8216 8330 8331 USE control_parameters, & 8332 ONLY: nesting_offline 8333 8217 8334 IMPLICIT NONE 8218 8335 … … 8232 8349 8233 8350 flag = 0.0_wp 8351 ! 8352 !-- Skip input if forcing from larger-scale models is applied. 8353 IF ( nesting_offline .AND. nesting_offline_salsa ) RETURN 8234 8354 ! 8235 8355 !-- Left and right boundaries … … 8403 8523 SUBROUTINE salsa_emission_update 8404 8524 8525 USE palm_date_time_mod, & 8526 ONLY: get_date_time 8527 8405 8528 IMPLICIT NONE 8406 8529 … … 8408 8531 8409 8532 IF ( time_since_reference_point >= skip_time_do_salsa ) THEN 8410 8411 IF ( next_aero_emission_update <= time_since_reference_point ) THEN 8533 ! 8534 !-- Get time_utc_init from origin_date_time 8535 CALL get_date_time( 0.0_wp, second_of_day = time_utc_init ) 8536 8537 IF ( next_aero_emission_update <= & 8538 MAX( time_since_reference_point, 0.0_wp ) + time_utc_init ) THEN 8412 8539 CALL salsa_emission_setup( .FALSE. ) 8413 8540 ENDIF 8414 8541 8415 IF ( next_gas_emission_update <= time_since_reference_point ) THEN 8542 IF ( next_gas_emission_update <= & 8543 MAX( time_since_reference_point, 0.0_wp ) + time_utc_init ) THEN 8416 8544 IF ( salsa_emission_mode == 'read_from_file' .AND. .NOT. salsa_gases_from_chem ) & 8417 8545 THEN … … 8474 8602 LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call 8475 8603 8476 REAL(wp) :: second_of_day !< second of the day 8604 REAL(wp) :: second_of_day !< second of the day 8605 8606 REAL(wp), DIMENSION(24) :: par_emis_time_factor = & !< time factors for the parameterized mode 8607 (/ 0.009, 0.004, 0.004, 0.009, 0.029, 0.039, & 8608 0.056, 0.053, 0.051, 0.051, 0.052, 0.055, & 8609 0.059, 0.061, 0.064, 0.067, 0.069, 0.069, & 8610 0.049, 0.039, 0.039, 0.029, 0.024, 0.019 /) 8477 8611 8478 8612 REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect_emission !< sectional number emission … … 8501 8635 ENDDO 8502 8636 ELSE 8637 ! 8638 !-- Get a time factor for the specific hour 8639 IF ( .NOT. ALLOCATED( aero_emission_att%time_factor ) ) & 8640 ALLOCATE( aero_emission_att%time_factor(1) ) 8641 CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), hour=hour_of_day ) 8642 index_hh = hour_of_day 8643 aero_emission_att%time_factor(1) = par_emis_time_factor(index_hh+1) 8644 8503 8645 IF ( street_type_f%from_file ) THEN 8504 8646 DO i = nxl, nxr … … 8506 8648 IF ( street_type_f%var(j,i) >= main_street_id .AND. & 8507 8649 street_type_f%var(j,i) < max_street_id ) THEN 8508 source_array(j,i,:) = nsect_emission(:) * emiss_factor_main 8650 source_array(j,i,:) = nsect_emission(:) * emiss_factor_main * & 8651 aero_emission_att%time_factor(1) 8509 8652 ELSEIF ( street_type_f%var(j,i) >= side_street_id .AND. & 8510 8653 street_type_f%var(j,i) < main_street_id ) THEN 8511 source_array(j,i,:) = nsect_emission(:) * emiss_factor_side 8654 source_array(j,i,:) = nsect_emission(:) * emiss_factor_side * & 8655 aero_emission_att%time_factor(1) 8512 8656 ENDIF 8513 8657 ENDDO … … 8587 8731 ! 8588 8732 !-- Read the index and name of chemical components 8589 CALL get_dimension_length( id_salsa, aero_emission_att%ncc, & 8590 'composition_index' ) 8733 CALL get_dimension_length( id_salsa, aero_emission_att%ncc, 'composition_index' ) 8591 8734 ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) ) 8592 8735 CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index ) … … 8629 8772 ENDIF 8630 8773 ! 8774 !-- Get number of emission categories 8775 CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' ) 8776 ! 8777 !-- Get the chemical composition (i.e. mass fraction of different species) in aerosols 8778 IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) ) THEN 8779 ALLOCATE( aero_emission%mass_fracs(1:aero_emission_att%ncat, & 8780 1:aero_emission_att%ncc) ) 8781 CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%mass_fracs, & 8782 0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 ) 8783 ELSE 8784 message_string = 'Missing emission_mass_fracs in ' // TRIM( input_file_salsa ) 8785 CALL message( 'salsa_emission_setup', 'PA0659', 1, 2, 0, 6, 0 ) 8786 ENDIF 8787 ! 8788 !-- If the chemical component is not activated, set its mass fraction to 0 to avoid 8789 !-- inbalance between number and mass flux 8790 cc_i2m = aero_emission_att%cc_in2mod 8791 IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) & 8792 aero_emission%mass_fracs(:,cc_i2m(1)) = 0.0_wp 8793 IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) & 8794 aero_emission%mass_fracs(:,cc_i2m(2)) = 0.0_wp 8795 IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) & 8796 aero_emission%mass_fracs(:,cc_i2m(3)) = 0.0_wp 8797 IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) & 8798 aero_emission%mass_fracs(:,cc_i2m(4)) = 0.0_wp 8799 IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) & 8800 aero_emission%mass_fracs(:,cc_i2m(5)) = 0.0_wp 8801 IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) & 8802 aero_emission%mass_fracs(:,cc_i2m(6)) = 0.0_wp 8803 IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) & 8804 aero_emission%mass_fracs(:,cc_i2m(7)) = 0.0_wp 8805 ! 8806 !-- Then normalise the mass fraction so that SUM = 1 8807 DO in = 1, aero_emission_att%ncat 8808 aero_emission%mass_fracs(in,:) = aero_emission%mass_fracs(in,:) / & 8809 SUM( aero_emission%mass_fracs(in,:) ) 8810 ENDDO 8811 ! 8631 8812 !-- Inquire the fill value 8632 8813 CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE., & … … 8659 8840 ENDIF 8660 8841 ! 8661 !-- Get number of emission categories and allocate emission arrays 8662 CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' ) 8842 !-- Allocate emission arrays 8663 8843 ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat), & 8664 8844 aero_emission_att%rho(1:aero_emission_att%ncat), & … … 8697 8877 !-- For each hour of year: 8698 8878 IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) ) THEN 8699 CALL get_dimension_length( id_salsa, & 8700 aero_emission_att%nhoursyear, 'nhoursyear' ) 8879 CALL get_dimension_length( id_salsa, aero_emission_att%nhoursyear, 'nhoursyear' ) 8701 8880 ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, & 8702 8881 1:aero_emission_att%nhoursyear) ) … … 8706 8885 !-- Based on the month, day and hour: 8707 8886 ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) ) THEN 8708 CALL get_dimension_length( id_salsa, & 8709 aero_emission_att%nmonthdayhour, & 8887 CALL get_dimension_length( id_salsa, aero_emission_att%nmonthdayhour, & 8710 8888 'nmonthdayhour' ) 8711 8889 ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, & … … 8720 8898 ! 8721 8899 !-- Next emission update 8722 CALL get_date_time( 0.0_wp, second_of_day=second_of_day ) 8723 next_aero_emission_update = MOD( second_of_day, seconds_per_hour ) - seconds_per_hour 8724 ! 8725 !-- Get chemical composition (i.e. mass fraction of different species) in aerosols 8726 IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) ) THEN 8727 ALLOCATE( aero_emission%def_mass_fracs(1:aero_emission_att%ncat, & 8728 1:aero_emission_att%ncc) ) 8729 aero_emission%def_mass_fracs = 0.0_wp 8730 CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%def_mass_fracs,& 8731 0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 ) 8732 ELSE 8733 message_string = 'Missing emission_mass_fracs in ' // TRIM( input_file_salsa ) 8734 CALL message( 'salsa_emission_setup', 'PA0659', 1, 2, 0, 6, 0 ) 8735 ENDIF 8736 ! 8737 !-- If the chemical component is not activated, set its mass fraction to 0 to avoid 8738 !-- inbalance between number and mass flux 8739 cc_i2m = aero_emission_att%cc_in2mod 8740 IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) & 8741 aero_emission%def_mass_fracs(:,cc_i2m(1)) = 0.0_wp 8742 IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) & 8743 aero_emission%def_mass_fracs(:,cc_i2m(2)) = 0.0_wp 8744 IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) & 8745 aero_emission%def_mass_fracs(:,cc_i2m(3)) = 0.0_wp 8746 IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) & 8747 aero_emission%def_mass_fracs(:,cc_i2m(4)) = 0.0_wp 8748 IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) & 8749 aero_emission%def_mass_fracs(:,cc_i2m(5)) = 0.0_wp 8750 IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) & 8751 aero_emission%def_mass_fracs(:,cc_i2m(6)) = 0.0_wp 8752 IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) & 8753 aero_emission%def_mass_fracs(:,cc_i2m(7)) = 0.0_wp 8754 ! 8755 !-- Then normalise the mass fraction so that SUM = 1 8756 DO in = 1, aero_emission_att%ncat 8757 aero_emission%def_mass_fracs(in,:) = aero_emission%def_mass_fracs(in,:) / & 8758 SUM( aero_emission%def_mass_fracs(in,:) ) 8759 ENDDO 8900 CALL get_date_time( time_since_reference_point, second_of_day=second_of_day ) 8901 next_aero_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour 8760 8902 ! 8761 8903 !-- Calculate average mass density (kg/m3) … … 8763 8905 8764 8906 IF ( cc_i2m(1) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoh2so4 *& 8765 aero_emission%def_mass_fracs(:,cc_i2m(1))8907 aero_emission%mass_fracs(:,cc_i2m(1)) 8766 8908 IF ( cc_i2m(2) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhooc * & 8767 aero_emission%def_mass_fracs(:,cc_i2m(2))8909 aero_emission%mass_fracs(:,cc_i2m(2)) 8768 8910 IF ( cc_i2m(3) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhobc * & 8769 aero_emission%def_mass_fracs(:,cc_i2m(3))8911 aero_emission%mass_fracs(:,cc_i2m(3)) 8770 8912 IF ( cc_i2m(4) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhodu * & 8771 aero_emission%def_mass_fracs(:,cc_i2m(4))8913 aero_emission%mass_fracs(:,cc_i2m(4)) 8772 8914 IF ( cc_i2m(5) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoss * & 8773 aero_emission%def_mass_fracs(:,cc_i2m(5))8915 aero_emission%mass_fracs(:,cc_i2m(5)) 8774 8916 IF ( cc_i2m(6) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhohno3 * & 8775 aero_emission%def_mass_fracs(:,cc_i2m(6))8917 aero_emission%mass_fracs(:,cc_i2m(6)) 8776 8918 IF ( cc_i2m(7) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhonh3 * & 8777 aero_emission%def_mass_fracs(:,cc_i2m(7))8919 aero_emission%mass_fracs(:,cc_i2m(7)) 8778 8920 ! 8779 8921 !-- Allocate and read surface emission data (in total PM) … … 8809 8951 ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol), & 8810 8952 aero_emission_att%time(1:aero_emission_att%nt), & 8811 aero_emission% preproc_mass_fracs(1:aero_emission_att%ncc) )8953 aero_emission%num_fracs(1:aero_emission_att%ncat,1:nbins_aerosol) ) 8812 8954 ! 8813 8955 !-- Read mean diameters … … 8831 8973 ENDIF 8832 8974 ! 8833 !-- Read emission mass fractions8834 IF ( check_existence( aero_emission_att%var_names, 'emission_ mass_fracs' ) ) THEN8835 CALL get_variable( id_salsa, 'emission_ mass_fracs',&8836 aero_emission%preproc_mass_fracs)8975 !-- Read emission number fractions per category 8976 IF ( check_existence( aero_emission_att%var_names, 'emission_number_fracs' ) ) THEN 8977 CALL get_variable( id_salsa, 'emission_number_fracs', aero_emission%num_fracs, & 8978 0, nbins_aerosol-1, 0, aero_emission_att%ncat-1 ) 8837 8979 ELSE 8838 message_string = 'Missing emission_ mass_fracs in ' // TRIM( input_file_salsa )8980 message_string = 'Missing emission_number_fracs in ' // TRIM( input_file_salsa ) 8839 8981 CALL message( 'salsa_emission_setup', 'PA0659', 1, 2, 0, 6, 0 ) 8840 8982 ENDIF 8841 !8842 !-- If the chemical component is not activated, set its mass fraction to 08843 cc_i2m = aero_emission_att%cc_in2mod8844 IF ( index_so4 < 0 .AND. cc_i2m(1) /= 0 ) &8845 aero_emission%preproc_mass_fracs(cc_i2m(1)) = 0.0_wp8846 IF ( index_oc < 0 .AND. cc_i2m(2) /= 0 ) &8847 aero_emission%preproc_mass_fracs(cc_i2m(2)) = 0.0_wp8848 IF ( index_bc < 0 .AND. cc_i2m(3) /= 0 ) &8849 aero_emission%preproc_mass_fracs(cc_i2m(3)) = 0.0_wp8850 IF ( index_du < 0 .AND. cc_i2m(4) /= 0 ) &8851 aero_emission%preproc_mass_fracs(cc_i2m(4)) = 0.0_wp8852 IF ( index_ss < 0 .AND. cc_i2m(5) /= 0 ) &8853 aero_emission%preproc_mass_fracs(cc_i2m(5)) = 0.0_wp8854 IF ( index_no < 0 .AND. cc_i2m(6) /= 0 ) &8855 aero_emission%preproc_mass_fracs(cc_i2m(6)) = 0.0_wp8856 IF ( index_nh < 0 .AND. cc_i2m(7) /= 0 ) &8857 aero_emission%preproc_mass_fracs(cc_i2m(7)) = 0.0_wp8858 !8859 !-- Then normalise the mass fraction so that SUM = 18860 aero_emission%preproc_mass_fracs = aero_emission%preproc_mass_fracs / &8861 SUM( aero_emission%preproc_mass_fracs )8862 8983 8863 8984 ELSE 8864 8985 message_string = 'Unknown lod for aerosol_emission_values.' 8865 8986 CALL message( 'salsa_emission','PA0637', 1, 2, 0, 6, 0 ) 8866 ENDIF 8987 8988 ENDIF ! lod 8867 8989 8868 8990 ENDIF ! init … … 8877 8999 ! 8878 9000 !-- Get the index of the current hour 8879 CALL get_date_time( time_since_reference_point,&9001 CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), & 8880 9002 day_of_year=day_of_year, hour=hour_of_day ) 8881 9003 index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day 8882 aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh )9004 aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh+1) 8883 9005 8884 9006 ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour ) THEN … … 8886 9008 !-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed. 8887 9009 !-- Needs to be calculated.) 8888 CALL get_date_time( time_since_reference_point, & 8889 month=month_of_year, & 8890 day=day_of_month, & 8891 hour=hour_of_day, & 8892 day_of_week=day_of_week ) 9010 CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), month=month_of_year,& 9011 day=day_of_month, hour=hour_of_day, day_of_week=day_of_week ) 8893 9012 index_mm = month_of_year 8894 9013 index_dd = months_per_year + day_of_week … … 8907 9026 aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) * & 8908 9027 aero_emission_att%etf(:,index_dd) * & 8909 aero_emission_att%etf(:,index_hh )9028 aero_emission_att%etf(:,index_hh+1) 8910 9029 ENDIF 8911 9030 … … 8939 9058 IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN 8940 9059 CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, & 8941 aero_emission% def_mass_fracs(in,:), source_array )9060 aero_emission%mass_fracs(in,:), source_array ) 8942 9061 ELSE 8943 9062 CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, & 8944 aero_emission% def_mass_fracs(in,:), source_array )9063 aero_emission%mass_fracs(in,:), source_array ) 8945 9064 CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, & 8946 aero_emission% def_mass_fracs(in,:), source_array )9065 aero_emission%mass_fracs(in,:), source_array ) 8947 9066 ENDIF 8948 9067 ENDDO … … 8957 9076 ELSEIF ( aero_emission_att%lod == 2 ) THEN 8958 9077 ! 8959 !-- Obtain time index for current input starting at 0. 8960 !-- @todo: At the moment emission data and simulated time correspond to each other. 8961 aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time - & 8962 time_since_reference_point ), DIM = 1 ) - 1 9078 !-- Get time_utc_init from origin_date_time 9079 CALL get_date_time( 0.0_wp, second_of_day = time_utc_init ) 9080 ! 9081 !-- Obtain time index for current point in time. Note, the time coordinate in the input 9082 !-- file is relative to time_utc_init. 9083 aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time - ( & 9084 time_utc_init + MAX( time_since_reference_point,& 9085 0.0_wp) ) ), DIM = 1 ) - 1 8963 9086 ! 8964 9087 !-- Allocate the data input array always before reading in the data and deallocate after 8965 ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:nbins_aerosol) ) 9088 ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat), & 9089 source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) ) 8966 9090 ! 8967 9091 !-- Read in the next time step 8968 CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data,& 8969 aero_emission_att%tind, 0, nbins_aerosol-1, nxl, nxr, nys, nyn ) 8970 ! 8971 !-- Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes only 8972 !-- for either default, land and urban surface. 8973 IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN 8974 CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, & 8975 aero_emission%preproc_mass_fracs, aero_emission%preproc_data ) 8976 ELSE 8977 CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, & 8978 aero_emission%preproc_mass_fracs, aero_emission%preproc_data ) 8979 CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, & 8980 aero_emission%preproc_mass_fracs, aero_emission%preproc_data ) 8981 ENDIF 9092 CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data, & 9093 aero_emission_att%tind, 0, aero_emission_att%ncat-1, & 9094 nxl, nxr, nys, nyn ) 9095 ! 9096 !-- Calculate the sources per category and set surface fluxes 9097 source_array = 0.0_wp 9098 DO in = 1, aero_emission_att%ncat 9099 DO ib = 1, nbins_aerosol 9100 source_array(:,:,ib) = aero_emission%preproc_data(:,:,in) * & 9101 aero_emission%num_fracs(in,ib) 9102 ENDDO 9103 ! 9104 !-- Set fluxes only for either default, land and urban surface. 9105 IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN 9106 CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, & 9107 aero_emission%mass_fracs(in,:), source_array ) 9108 ELSE 9109 CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, & 9110 aero_emission%mass_fracs(in,:), source_array ) 9111 CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, & 9112 aero_emission%mass_fracs(in,:), source_array ) 9113 ENDIF 9114 ENDDO 8982 9115 ! 8983 9116 !-- Determine the next emission update 8984 9117 next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2) 8985 9118 8986 DEALLOCATE( aero_emission%preproc_data )9119 DEALLOCATE( aero_emission%preproc_data, source_array ) 8987 9120 8988 9121 ENDIF … … 9347 9480 !-- Next emission update 9348 9481 CALL get_date_time( time_since_reference_point, second_of_day=second_of_day ) 9349 next_gas_emission_update = MOD( second_of_day, seconds_per_hour ) - seconds_per_hour9482 next_gas_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour 9350 9483 ! 9351 9484 !-- Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data … … 9395 9528 day_of_year=day_of_year, hour=hour_of_day ) 9396 9529 index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day 9397 time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh) 9530 IF ( .NOT. ALLOCATED( time_factor ) ) ALLOCATE( time_factor(1:chem_emission_att%ncat) ) 9531 time_factor = 0.0_wp 9532 time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh+1) 9398 9533 9399 9534 ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour ) THEN … … 9408 9543 index_mm = month_of_year 9409 9544 index_dd = months_per_year + day_of_week 9410 SELECT CASE( TRIM(daytype))9545 SELECT CASE( TRIM( daytype ) ) 9411 9546 9412 9547 CASE ("workday") … … 9422 9557 time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) * & 9423 9558 chem_emission_att%mdh_emis_time_factor(:,index_dd) * & 9424 chem_emission_att%mdh_emis_time_factor(:,index_hh )9559 chem_emission_att%mdh_emis_time_factor(:,index_hh+1) 9425 9560 ENDIF 9426 9561 ! … … 9435 9570 !-- Set surface fluxes only for either default, land or urban surface 9436 9571 IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN 9437 CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, 9438 dum_var_3d (:,:,in), time_factor(in) )9572 CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, & 9573 dum_var_3d, time_factor(in) ) 9439 9574 ELSE 9440 CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, 9441 dum_var_3d (:,:,in), time_factor(in) )9442 CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, 9443 dum_var_3d (:,:,in), time_factor(in) )9575 CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, & 9576 dum_var_3d, time_factor(in) ) 9577 CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, & 9578 dum_var_3d, time_factor(in) ) 9444 9579 ENDIF 9445 9580 ENDDO … … 9451 9586 ELSEIF ( lod_gas_emissions == 2 ) THEN 9452 9587 ! 9453 !-- Obtain time index for current input starting at 0. 9454 !-- @todo: At the moment emission data and simulated time correspond to each other. 9455 chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time - time_since_reference_point ), & 9456 DIM = 1 ) - 1 9588 !-- Get time_utc_init from origin_date_time 9589 CALL get_date_time( 0.0_wp, second_of_day = time_utc_init ) 9590 ! 9591 !-- Obtain time index for current point in time. Note, the time coordinate in the input file is 9592 !-- relative to time_utc_init. 9593 chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time - ( time_utc_init + & 9594 MAX( time_since_reference_point, 0.0_wp) ) ), DIM = 1 ) - 1 9457 9595 ! 9458 9596 !-- Allocate the data input array always before reading in the data and deallocate after (NOTE … … 9527 9665 REAL(wp), DIMENSION(ngases_salsa) :: conv !< unit conversion factor 9528 9666 9529 REAL(wp), DIMENSION(nys:nyn,nxl:nxr, chem_emission_att%n_emiss_species), INTENT(in) :: source_array !<9667 REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species), INTENT(in) :: source_array !< 9530 9668 9531 9669 TYPE(surf_type), INTENT(inout) :: surface !< respective surface type … … 11967 12105 END FUNCTION 11968 12106 12107 !------------------------------------------------------------------------------! 12108 ! Description: 12109 ! ------------ 12110 !> Set the lateral and top boundary conditions in case the PALM domain is 12111 !> nested offline in a mesoscale model. Further, average boundary data and 12112 !> determine mean profiles, further used for correct damping in the sponge 12113 !> layer. 12114 !------------------------------------------------------------------------------! 12115 SUBROUTINE salsa_nesting_offl_bc 12116 12117 USE control_parameters, & 12118 ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, dt_3d, & 12119 time_since_reference_point 12120 12121 USE indices, & 12122 ONLY: nbgp, nxl, nxr, nyn, nys, nzb, nzt 12123 12124 IMPLICIT NONE 12125 12126 INTEGER(iwp) :: i !< running index x-direction 12127 INTEGER(iwp) :: ib !< running index for aerosol number bins 12128 INTEGER(iwp) :: ic !< running index for aerosol mass bins 12129 INTEGER(iwp) :: icc !< running index for aerosol mass bins 12130 INTEGER(iwp) :: ig !< running index for gaseous species 12131 INTEGER(iwp) :: j !< running index y-direction 12132 INTEGER(iwp) :: k !< running index z-direction 12133 12134 REAL(wp) :: fac_dt !< interpolation factor 12135 12136 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_mconc !< reference profile for aerosol mass 12137 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_mconc_l !< reference profile for aerosol mass: subdomain 12138 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_nconc !< reference profile for aerosol number 12139 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_nconc_l !< reference profile for aerosol_number: subdomain 12140 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_gconc !< reference profile for gases 12141 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_gconc_l !< reference profile for gases: subdomain 12142 12143 ! 12144 !-- Skip input if no forcing from larger-scale models is applied. 12145 IF ( .NOT. nesting_offline_salsa ) RETURN 12146 ! 12147 !-- Allocate temporary arrays to compute salsa mean profiles 12148 ALLOCATE( ref_gconc(nzb:nzt+1,1:ngases_salsa), ref_gconc_l(nzb:nzt+1,1:ngases_salsa), & 12149 ref_mconc(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass), & 12150 ref_mconc_l(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass), & 12151 ref_nconc(nzb:nzt+1,1:nbins_aerosol), ref_nconc_l(nzb:nzt+1,1:nbins_aerosol) ) 12152 ref_gconc = 0.0_wp 12153 ref_gconc_l = 0.0_wp 12154 ref_mconc = 0.0_wp 12155 ref_mconc_l = 0.0_wp 12156 ref_nconc = 0.0_wp 12157 ref_nconc_l = 0.0_wp 12158 12159 ! 12160 !-- Determine interpolation factor and limit it to 1. This is because t+dt can slightly exceed 12161 !-- time(tind_p) before boundary data is updated again. 12162 fac_dt = ( time_since_reference_point - salsa_nest_offl%time(salsa_nest_offl%tind) + dt_3d ) & 12163 / ( salsa_nest_offl%time(salsa_nest_offl%tind_p) - & 12164 salsa_nest_offl%time(salsa_nest_offl%tind) ) 12165 fac_dt = MIN( 1.0_wp, fac_dt ) 12166 12167 IF ( bc_dirichlet_l ) THEN 12168 DO ib = 1, nbins_aerosol 12169 DO j = nys, nyn 12170 DO k = nzb+1, nzt 12171 aerosol_number(ib)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * & 12172 salsa_nest_offl%nconc_left(0,k,j,ib) + fac_dt * & 12173 salsa_nest_offl%nconc_left(1,k,j,ib) 12174 ENDDO 12175 ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + & 12176 aerosol_number(ib)%conc(nzb+1:nzt,j,-1) 12177 ENDDO 12178 DO ic = 1, ncomponents_mass 12179 icc = ( ic-1 ) * nbins_aerosol + ib 12180 DO j = nys, nyn 12181 DO k = nzb+1, nzt 12182 aerosol_mass(icc)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * & 12183 salsa_nest_offl%mconc_left(0,k,j,icc) + fac_dt & 12184 * salsa_nest_offl%mconc_left(1,k,j,icc) 12185 ENDDO 12186 ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + & 12187 aerosol_mass(icc)%conc(nzb+1:nzt,j,-1) 12188 ENDDO 12189 ENDDO 12190 ENDDO 12191 IF ( .NOT. salsa_gases_from_chem ) THEN 12192 DO ig = 1, ngases_salsa 12193 DO j = nys, nyn 12194 DO k = nzb+1, nzt 12195 salsa_gas(ig)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * & 12196 salsa_nest_offl%gconc_left(0,k,j,ig) + fac_dt * & 12197 salsa_nest_offl%gconc_left(1,k,j,ig) 12198 ENDDO 12199 ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + & 12200 salsa_gas(ig)%conc(nzb+1:nzt,j,-1) 12201 ENDDO 12202 ENDDO 12203 ENDIF 12204 ENDIF 12205 12206 IF ( bc_dirichlet_r ) THEN 12207 DO ib = 1, nbins_aerosol 12208 DO j = nys, nyn 12209 DO k = nzb+1, nzt 12210 aerosol_number(ib)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * & 12211 salsa_nest_offl%nconc_right(0,k,j,ib) + fac_dt * & 12212 salsa_nest_offl%nconc_right(1,k,j,ib) 12213 ENDDO 12214 ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + & 12215 aerosol_number(ib)%conc(nzb+1:nzt,j,nxr+1) 12216 ENDDO 12217 DO ic = 1, ncomponents_mass 12218 icc = ( ic-1 ) * nbins_aerosol + ib 12219 DO j = nys, nyn 12220 DO k = nzb+1, nzt 12221 aerosol_mass(icc)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * & 12222 salsa_nest_offl%mconc_right(0,k,j,icc) + fac_dt& 12223 * salsa_nest_offl%mconc_right(1,k,j,icc) 12224 ENDDO 12225 ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + & 12226 aerosol_mass(icc)%conc(nzb+1:nzt,j,nxr+1) 12227 ENDDO 12228 ENDDO 12229 ENDDO 12230 IF ( .NOT. salsa_gases_from_chem ) THEN 12231 DO ig = 1, ngases_salsa 12232 DO j = nys, nyn 12233 DO k = nzb+1, nzt 12234 salsa_gas(ig)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * & 12235 salsa_nest_offl%gconc_right(0,k,j,ig) + fac_dt *& 12236 salsa_nest_offl%gconc_right(1,k,j,ig) 12237 ENDDO 12238 ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + & 12239 salsa_gas(ig)%conc(nzb+1:nzt,j,nxr+1) 12240 ENDDO 12241 ENDDO 12242 ENDIF 12243 ENDIF 12244 12245 IF ( bc_dirichlet_n ) THEN 12246 DO ib = 1, nbins_aerosol 12247 DO i = nxl, nxr 12248 DO k = nzb+1, nzt 12249 aerosol_number(ib)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * & 12250 salsa_nest_offl%nconc_north(0,k,i,ib) + fac_dt * & 12251 salsa_nest_offl%nconc_north(1,k,i,ib) 12252 ENDDO 12253 ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + & 12254 aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,i) 12255 ENDDO 12256 DO ic = 1, ncomponents_mass 12257 icc = ( ic-1 ) * nbins_aerosol + ib 12258 DO i = nxl, nxr 12259 DO k = nzb+1, nzt 12260 aerosol_mass(icc)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * & 12261 salsa_nest_offl%mconc_north(0,k,i,icc) + fac_dt& 12262 * salsa_nest_offl%mconc_north(1,k,i,icc) 12263 ENDDO 12264 ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + & 12265 aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,i) 12266 ENDDO 12267 ENDDO 12268 ENDDO 12269 IF ( .NOT. salsa_gases_from_chem ) THEN 12270 DO ig = 1, ngases_salsa 12271 DO i = nxl, nxr 12272 DO k = nzb+1, nzt 12273 salsa_gas(ig)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * & 12274 salsa_nest_offl%gconc_north(0,k,i,ig) + fac_dt *& 12275 salsa_nest_offl%gconc_north(1,k,i,ig) 12276 ENDDO 12277 ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + & 12278 salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,i) 12279 ENDDO 12280 ENDDO 12281 ENDIF 12282 ENDIF 12283 12284 IF ( bc_dirichlet_s ) THEN 12285 DO ib = 1, nbins_aerosol 12286 DO i = nxl, nxr 12287 DO k = nzb+1, nzt 12288 aerosol_number(ib)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * & 12289 salsa_nest_offl%nconc_south(0,k,i,ib) + fac_dt * & 12290 salsa_nest_offl%nconc_south(1,k,i,ib) 12291 ENDDO 12292 ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + & 12293 aerosol_number(ib)%conc(nzb+1:nzt,-1,i) 12294 ENDDO 12295 DO ic = 1, ncomponents_mass 12296 icc = ( ic-1 ) * nbins_aerosol + ib 12297 DO i = nxl, nxr 12298 DO k = nzb+1, nzt 12299 aerosol_mass(icc)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * & 12300 salsa_nest_offl%mconc_south(0,k,i,icc) + fac_dt& 12301 * salsa_nest_offl%mconc_south(1,k,i,icc) 12302 ENDDO 12303 ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + & 12304 aerosol_mass(icc)%conc(nzb+1:nzt,-1,i) 12305 ENDDO 12306 ENDDO 12307 ENDDO 12308 IF ( .NOT. salsa_gases_from_chem ) THEN 12309 DO ig = 1, ngases_salsa 12310 DO i = nxl, nxr 12311 DO k = nzb+1, nzt 12312 salsa_gas(ig)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * & 12313 salsa_nest_offl%gconc_south(0,k,i,ig) + fac_dt * & 12314 salsa_nest_offl%gconc_south(1,k,i,ig) 12315 ENDDO 12316 ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + & 12317 salsa_gas(ig)%conc(nzb+1:nzt,-1,i) 12318 ENDDO 12319 ENDDO 12320 ENDIF 12321 ENDIF 12322 ! 12323 !-- Top boundary 12324 DO ib = 1, nbins_aerosol 12325 DO i = nxl, nxr 12326 DO j = nys, nyn 12327 aerosol_number(ib)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * & 12328 salsa_nest_offl%nconc_top(0,j,i,ib) + fac_dt * & 12329 salsa_nest_offl%nconc_top(1,j,i,ib) 12330 ref_nconc_l(nzt+1,ib) = ref_nconc_l(nzt+1,ib) + aerosol_number(ib)%conc(nzt+1,j,i) 12331 ENDDO 12332 ENDDO 12333 DO ic = 1, ncomponents_mass 12334 icc = ( ic-1 ) * nbins_aerosol + ib 12335 DO i = nxl, nxr 12336 DO j = nys, nyn 12337 aerosol_mass(icc)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * & 12338 salsa_nest_offl%mconc_top(0,j,i,icc) + fac_dt *& 12339 salsa_nest_offl%mconc_top(1,j,i,icc) 12340 ref_mconc_l(nzt+1,icc) = ref_mconc_l(nzt+1,icc) + aerosol_mass(icc)%conc(nzt+1,j,i) 12341 ENDDO 12342 ENDDO 12343 ENDDO 12344 ENDDO 12345 IF ( .NOT. salsa_gases_from_chem ) THEN 12346 DO ig = 1, ngases_salsa 12347 DO i = nxl, nxr 12348 DO j = nys, nyn 12349 salsa_gas(ig)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * & 12350 salsa_nest_offl%gconc_top(0,j,i,ig) + fac_dt * & 12351 salsa_nest_offl%gconc_top(1,j,i,ig) 12352 ref_gconc_l(nzt+1,ig) = ref_gconc_l(nzt+1,ig) + salsa_gas(ig)%conc(nzt+1,j,i) 12353 ENDDO 12354 ENDDO 12355 ENDDO 12356 ENDIF 12357 ! 12358 !-- Do local exchange 12359 DO ib = 1, nbins_aerosol 12360 CALL exchange_horiz( aerosol_number(ib)%conc, nbgp ) 12361 DO ic = 1, ncomponents_mass 12362 icc = ( ic-1 ) * nbins_aerosol + ib 12363 CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp ) 12364 ENDDO 12365 ENDDO 12366 IF ( .NOT. salsa_gases_from_chem ) THEN 12367 DO ig = 1, ngases_salsa 12368 CALL exchange_horiz( salsa_gas(ig)%conc, nbgp ) 12369 ENDDO 12370 ENDIF 12371 ! 12372 !-- In case of Rayleigh damping, where the initial profiles are still used, update these profiles 12373 !-- from the averaged boundary data. But first, average these data. 12374 #if defined( __parallel ) 12375 IF ( .NOT. salsa_gases_from_chem ) & 12376 CALL MPI_ALLREDUCE( ref_gconc_l, ref_gconc, ( nzt+1-nzb+1 ) * SIZE( ref_gconc(nzb,:) ), & 12377 MPI_REAL, MPI_SUM, comm2d, ierr ) 12378 CALL MPI_ALLREDUCE( ref_mconc_l, ref_mconc, ( nzt+1-nzb+1 ) * SIZE( ref_mconc(nzb,:) ), & 12379 MPI_REAL, MPI_SUM, comm2d, ierr ) 12380 CALL MPI_ALLREDUCE( ref_nconc_l, ref_nconc, ( nzt+1-nzb+1 ) * SIZE( ref_nconc(nzb,:) ), & 12381 MPI_REAL, MPI_SUM, comm2d, ierr ) 12382 #else 12383 IF ( .NOT. salsa_gases_from_chem ) ref_gconc = ref_gconc_l 12384 ref_mconc = ref_mconc_l 12385 ref_nconc = ref_nconc_l 12386 #endif 12387 ! 12388 !-- Average data. Note, reference profiles up to nzt are derived from lateral boundaries, at the 12389 !-- model top it is derived from the top boundary. Thus, number of input data is different from 12390 !-- nzb:nzt compared to nzt+1. 12391 !-- Derived from lateral boundaries. 12392 IF ( .NOT. salsa_gases_from_chem ) & 12393 ref_gconc(nzb:nzt,:) = ref_gconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp ) 12394 ref_mconc(nzb:nzt,:) = ref_mconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp ) 12395 ref_nconc(nzb:nzt,:) = ref_nconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp ) 12396 ! 12397 !-- Derived from top boundary 12398 IF ( .NOT. salsa_gases_from_chem ) & 12399 ref_gconc(nzt+1,:) = ref_gconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp ) 12400 ref_mconc(nzt+1,:) = ref_mconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp ) 12401 ref_nconc(nzt+1,:) = ref_nconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp ) 12402 ! 12403 !-- Write onto init profiles, which are used for damping. Also set lower boundary condition. 12404 DO ib = 1, nbins_aerosol 12405 aerosol_number(ib)%init(:) = ref_nconc(:,ib) 12406 aerosol_number(ib)%init(nzb) = aerosol_number(ib)%init(nzb+1) 12407 DO ic = 1, ncomponents_mass 12408 icc = ( ic-1 ) * nbins_aerosol + ib 12409 aerosol_mass(icc)%init(:) = ref_mconc(:,icc) 12410 aerosol_mass(icc)%init(nzb) = aerosol_mass(icc)%init(nzb+1) 12411 ENDDO 12412 ENDDO 12413 IF ( .NOT. salsa_gases_from_chem ) THEN 12414 DO ig = 1, ngases_salsa 12415 salsa_gas(ig)%init(:) = ref_gconc(:,ig) 12416 salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1) 12417 ENDDO 12418 ENDIF 12419 12420 DEALLOCATE( ref_gconc, ref_gconc_l, ref_mconc, ref_mconc_l, ref_nconc, ref_nconc_l ) 12421 12422 END SUBROUTINE salsa_nesting_offl_bc 12423 12424 !------------------------------------------------------------------------------! 12425 ! Description: 12426 ! ------------ 12427 !> Allocate arrays used to read boundary data from NetCDF file and initialize 12428 !> boundary data. 12429 !------------------------------------------------------------------------------! 12430 SUBROUTINE salsa_nesting_offl_init 12431 12432 USE control_parameters, & 12433 ONLY: end_time, initializing_actions, spinup_time 12434 12435 USE palm_date_time_mod, & 12436 ONLY: get_date_time 12437 12438 IMPLICIT NONE 12439 12440 INTEGER(iwp) :: ib !< running index for aerosol number bins 12441 INTEGER(iwp) :: ic !< running index for aerosol mass bins 12442 INTEGER(iwp) :: icc !< additional running index for aerosol mass bins 12443 INTEGER(iwp) :: ig !< running index for gaseous species 12444 INTEGER(iwp) :: nmass_bins !< number of aerosol mass bins 12445 12446 nmass_bins = nbins_aerosol * ncomponents_mass 12447 ! 12448 !-- Get time_utc_init from origin_date_time 12449 CALL get_date_time( 0.0_wp, second_of_day = time_utc_init ) 12450 ! 12451 !-- Allocate arrays for reading boundary values. Arrays will incorporate 2 time levels in order to 12452 !-- interpolate in between. 12453 IF ( nesting_offline_salsa ) THEN 12454 IF ( bc_dirichlet_l ) THEN 12455 ALLOCATE( salsa_nest_offl%nconc_left(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) ) 12456 ALLOCATE( salsa_nest_offl%mconc_left(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) ) 12457 ENDIF 12458 IF ( bc_dirichlet_r ) THEN 12459 ALLOCATE( salsa_nest_offl%nconc_right(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) ) 12460 ALLOCATE( salsa_nest_offl%mconc_right(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) ) 12461 ENDIF 12462 IF ( bc_dirichlet_n ) THEN 12463 ALLOCATE( salsa_nest_offl%nconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) ) 12464 ALLOCATE( salsa_nest_offl%mconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) ) 12465 ENDIF 12466 IF ( bc_dirichlet_s ) THEN 12467 ALLOCATE( salsa_nest_offl%nconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) ) 12468 ALLOCATE( salsa_nest_offl%mconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) ) 12469 ENDIF 12470 ALLOCATE( salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol) ) 12471 ALLOCATE( salsa_nest_offl%mconc_top(0:1,nys:nyn,nxl:nxr,1:nmass_bins) ) 12472 12473 IF ( .NOT. salsa_gases_from_chem ) THEN 12474 IF ( bc_dirichlet_l ) THEN 12475 ALLOCATE( salsa_nest_offl%gconc_left(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) ) 12476 ENDIF 12477 IF ( bc_dirichlet_r ) THEN 12478 ALLOCATE( salsa_nest_offl%gconc_right(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) ) 12479 ENDIF 12480 IF ( bc_dirichlet_n ) THEN 12481 ALLOCATE( salsa_nest_offl%gconc_north(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) ) 12482 ENDIF 12483 IF ( bc_dirichlet_s ) THEN 12484 ALLOCATE( salsa_nest_offl%gconc_south(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) ) 12485 ENDIF 12486 ALLOCATE( salsa_nest_offl%gconc_top(0:1,nys:nyn,nxl:nxr,1:ngases_salsa) ) 12487 ENDIF 12488 12489 ! 12490 !-- Read data at lateral and top boundaries from a larger-scale model 12491 CALL salsa_nesting_offl_input 12492 ! 12493 !-- Check if sufficient time steps are provided to cover the entire simulation. Note, dynamic 12494 !-- input is only required for the 3D simulation, not for the soil/wall spinup. However, as the 12495 !-- spinup time is added to the end_time, this must be considered here. 12496 IF ( end_time - spinup_time > & 12497 salsa_nest_offl%time(salsa_nest_offl%nt-1) - time_utc_init ) THEN 12498 message_string = 'end_time of the simulation exceeds the time dimension in the dynamic'//& 12499 ' input file.' 12500 CALL message( 'salsa_nesting_offl_init', 'PA0681', 1, 2, 0, 6, 0 ) 12501 ENDIF 12502 12503 IF ( salsa_nest_offl%time(0) /= time_utc_init ) THEN 12504 message_string = 'Offline nesting: time dimension must start at time_utc_init.' 12505 CALL message( 'salsa_nesting_offl_init', 'PA0682', 1, 2, 0, 6, 0 ) 12506 ENDIF 12507 ! 12508 !-- Initialize boundary data. Please note, do not initialize boundaries in case of restart runs. 12509 IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. read_restart_data_salsa ) & 12510 THEN 12511 IF ( bc_dirichlet_l ) THEN 12512 DO ib = 1, nbins_aerosol 12513 aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,-1) = & 12514 salsa_nest_offl%nconc_left(0,nzb+1:nzt,nys:nyn,ib) 12515 DO ic = 1, ncomponents_mass 12516 icc = ( ic - 1 ) * nbins_aerosol + ib 12517 aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,-1) = & 12518 salsa_nest_offl%mconc_left(0,nzb+1:nzt,nys:nyn,icc) 12519 ENDDO 12520 ENDDO 12521 DO ig = 1, ngases_salsa 12522 salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,-1) = & 12523 salsa_nest_offl%gconc_left(0,nzb+1:nzt,nys:nyn,ig) 12524 ENDDO 12525 ENDIF 12526 IF ( bc_dirichlet_r ) THEN 12527 DO ib = 1, nbins_aerosol 12528 aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,nxr+1) = & 12529 salsa_nest_offl%nconc_right(0,nzb+1:nzt,nys:nyn,ib) 12530 DO ic = 1, ncomponents_mass 12531 icc = ( ic - 1 ) * nbins_aerosol + ib 12532 aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,nxr+1) = & 12533 salsa_nest_offl%mconc_right(0,nzb+1:nzt,nys:nyn,icc) 12534 ENDDO 12535 ENDDO 12536 DO ig = 1, ngases_salsa 12537 salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,nxr+1) = & 12538 salsa_nest_offl%gconc_right(0,nzb+1:nzt,nys:nyn,ig) 12539 ENDDO 12540 ENDIF 12541 IF ( bc_dirichlet_n ) THEN 12542 DO ib = 1, nbins_aerosol 12543 aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = & 12544 salsa_nest_offl%nconc_north(0,nzb+1:nzt,nxl:nxr,ib) 12545 DO ic = 1, ncomponents_mass 12546 icc = ( ic - 1 ) * nbins_aerosol + ib 12547 aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = & 12548 salsa_nest_offl%mconc_north(0,nzb+1:nzt,nxl:nxr,icc) 12549 ENDDO 12550 ENDDO 12551 DO ig = 1, ngases_salsa 12552 salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = & 12553 salsa_nest_offl%gconc_north(0,nzb+1:nzt,nxl:nxr,ig) 12554 ENDDO 12555 ENDIF 12556 IF ( bc_dirichlet_s ) THEN 12557 DO ib = 1, nbins_aerosol 12558 aerosol_number(ib)%conc(nzb+1:nzt,-1,nxl:nxr) = & 12559 salsa_nest_offl%nconc_south(0,nzb+1:nzt,nxl:nxr,ib) 12560 DO ic = 1, ncomponents_mass 12561 icc = ( ic - 1 ) * nbins_aerosol + ib 12562 aerosol_mass(icc)%conc(nzb+1:nzt,-1,nxl:nxr) = & 12563 salsa_nest_offl%mconc_south(0,nzb+1:nzt,nxl:nxr,icc) 12564 ENDDO 12565 ENDDO 12566 DO ig = 1, ngases_salsa 12567 salsa_gas(ig)%conc(nzb+1:nzt,-1,nxl:nxr) = & 12568 salsa_nest_offl%gconc_south(0,nzb+1:nzt,nxl:nxr,ig) 12569 ENDDO 12570 ENDIF 12571 ENDIF 12572 ENDIF 12573 12574 END SUBROUTINE salsa_nesting_offl_init 12575 12576 !------------------------------------------------------------------------------! 12577 ! Description: 12578 ! ------------ 12579 !> Set the lateral and top boundary conditions in case the PALM domain is 12580 !> nested offline in a mesoscale model. Further, average boundary data and 12581 !> determine mean profiles, further used for correct damping in the sponge 12582 !> layer. 12583 !------------------------------------------------------------------------------! 12584 SUBROUTINE salsa_nesting_offl_input 12585 12586 USE netcdf_data_input_mod, & 12587 ONLY: check_existence, close_input_file, get_attribute, get_variable, & 12588 inquire_num_variables, inquire_variable_names, & 12589 get_dimension_length, open_read_file 12590 12591 IMPLICIT NONE 12592 12593 CHARACTER(LEN=25) :: vname !< variable name 12594 12595 INTEGER(iwp) :: ic !< running index for aerosol chemical components 12596 INTEGER(iwp) :: ig !< running index for gases 12597 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 12598 12599 ! 12600 !-- Skip input if no forcing from larger-scale models is applied. 12601 IF ( .NOT. nesting_offline_salsa ) RETURN 12602 ! 12603 !-- Initialise 12604 IF ( .NOT. salsa_nest_offl%init ) THEN 12605 12606 #if defined ( __netcdf ) 12607 ! 12608 !-- Open file in read-only mode 12609 CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), & 12610 salsa_nest_offl%id_dynamic ) 12611 ! 12612 !-- At first, inquire all variable names. 12613 CALL inquire_num_variables( salsa_nest_offl%id_dynamic, num_vars ) 12614 ! 12615 !-- Allocate memory to store variable names. 12616 ALLOCATE( salsa_nest_offl%var_names(1:num_vars) ) 12617 CALL inquire_variable_names( salsa_nest_offl%id_dynamic, salsa_nest_offl%var_names ) 12618 ! 12619 !-- Read time dimension, allocate memory and finally read time array 12620 CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nt,& 12621 'time' ) 12622 12623 IF ( check_existence( salsa_nest_offl%var_names, 'time' ) ) THEN 12624 ALLOCATE( salsa_nest_offl%time(0:salsa_nest_offl%nt-1) ) 12625 CALL get_variable( salsa_nest_offl%id_dynamic, 'time', salsa_nest_offl%time ) 12626 ENDIF 12627 ! 12628 !-- Read the vertical dimension 12629 CALL get_dimension_length( salsa_nest_offl%id_dynamic, & 12630 salsa_nest_offl%nzu, 'z' ) 12631 ALLOCATE( salsa_nest_offl%zu_atmos(1:salsa_nest_offl%nzu) ) 12632 CALL get_variable( salsa_nest_offl%id_dynamic, 'z', salsa_nest_offl%zu_atmos ) 12633 ! 12634 !-- Read the number of aerosol chemical components 12635 CALL get_dimension_length( salsa_nest_offl%id_dynamic, & 12636 salsa_nest_offl%ncc, 'composition_index' ) 12637 ! 12638 !-- Read the names of aerosol chemical components 12639 CALL get_variable( salsa_nest_offl%id_dynamic, 'composition_name', salsa_nest_offl%cc_name, & 12640 salsa_nest_offl%ncc ) 12641 ! 12642 !-- Define the index of each chemical component in the model 12643 DO ic = 1, salsa_nest_offl%ncc 12644 SELECT CASE ( TRIM( salsa_nest_offl%cc_name(ic) ) ) 12645 CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' ) 12646 salsa_nest_offl%cc_in2mod(1) = ic 12647 CASE ( 'OC', 'oc' ) 12648 salsa_nest_offl%cc_in2mod(2) = ic 12649 CASE ( 'BC', 'bc' ) 12650 salsa_nest_offl%cc_in2mod(3) = ic 12651 CASE ( 'DU', 'du' ) 12652 salsa_nest_offl%cc_in2mod(4) = ic 12653 CASE ( 'SS', 'ss' ) 12654 salsa_nest_offl%cc_in2mod(5) = ic 12655 CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' ) 12656 salsa_nest_offl%cc_in2mod(6) = ic 12657 CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' ) 12658 salsa_nest_offl%cc_in2mod(7) = ic 12659 END SELECT 12660 ENDDO 12661 IF ( SUM( salsa_nest_offl%cc_in2mod ) == 0 ) THEN 12662 message_string = 'None of the aerosol chemical components in ' // & 12663 TRIM( input_file_dynamic ) // ' correspond to ones applied in SALSA.' 12664 CALL message( 'salsa_mod: salsa_nesting_offl_input', & 12665 'PA0662', 2, 2, 0, 6, 0 ) 12666 ENDIF 12667 #endif 12668 ENDIF 12669 ! 12670 !-- Check if dynamic driver data input is required. 12671 IF ( salsa_nest_offl%time(salsa_nest_offl%tind_p) <= MAX( time_since_reference_point, 0.0_wp) & 12672 + time_utc_init .OR. .NOT. salsa_nest_offl%init ) THEN 12673 CONTINUE 12674 ! 12675 !-- Return otherwise 12676 ELSE 12677 RETURN 12678 ENDIF 12679 ! 12680 !-- Obtain time index for current point in time. 12681 salsa_nest_offl%tind = MINLOC( ABS( salsa_nest_offl%time - ( time_utc_init + & 12682 MAX( time_since_reference_point, 0.0_wp) ) ), DIM = 1 ) - 1 12683 salsa_nest_offl%tind_p = salsa_nest_offl%tind + 1 12684 ! 12685 !-- Open file in read-only mode 12686 #if defined ( __netcdf ) 12687 12688 CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), & 12689 salsa_nest_offl%id_dynamic ) 12690 ! 12691 !-- Read data at the western boundary 12692 CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_left_aerosol', & 12693 salsa_nest_offl%nconc_left, & 12694 MERGE( 0, 1, bc_dirichlet_l ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_l ), & 12695 MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ), & 12696 MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ), & 12697 MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_l ), & 12698 MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) ) 12699 IF ( bc_dirichlet_l ) THEN 12700 salsa_nest_offl%nconc_left = MAX( nclim, salsa_nest_offl%nconc_left ) 12701 CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, & 12702 nyn, 'ls_forcing_left_mass_fracs_a', 1 ) 12703 ENDIF 12704 IF ( .NOT. salsa_gases_from_chem ) THEN 12705 DO ig = 1, ngases_salsa 12706 vname = salsa_nest_offl%char_l // salsa_nest_offl%gas_name(ig) 12707 CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), & 12708 salsa_nest_offl%gconc_left(:,:,:,ig), & 12709 MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ), & 12710 MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ), & 12711 MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_l ), & 12712 MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) ) 12713 IF ( bc_dirichlet_l ) salsa_nest_offl%gconc_left(:,:,:,ig) = & 12714 MAX( nclim, salsa_nest_offl%gconc_left(:,:,:,ig) ) 12715 ENDDO 12716 ENDIF 12717 ! 12718 !-- Read data at the eastern boundary 12719 CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_right_aerosol', & 12720 salsa_nest_offl%nconc_right, & 12721 MERGE( 0, 1, bc_dirichlet_r ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_r ), & 12722 MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ), & 12723 MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ), & 12724 MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_r ), & 12725 MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) ) 12726 IF ( bc_dirichlet_r ) THEN 12727 salsa_nest_offl%nconc_right = MAX( nclim, salsa_nest_offl%nconc_right ) 12728 CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, & 12729 nyn, 'ls_forcing_right_mass_fracs_a', 2 ) 12730 ENDIF 12731 IF ( .NOT. salsa_gases_from_chem ) THEN 12732 DO ig = 1, ngases_salsa 12733 vname = salsa_nest_offl%char_r // salsa_nest_offl%gas_name(ig) 12734 CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), & 12735 salsa_nest_offl%gconc_right(:,:,:,ig), & 12736 MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ), & 12737 MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ), & 12738 MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_r ), & 12739 MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) ) 12740 IF ( bc_dirichlet_r ) salsa_nest_offl%gconc_right(:,:,:,ig) = & 12741 MAX( nclim, salsa_nest_offl%gconc_right(:,:,:,ig) ) 12742 ENDDO 12743 ENDIF 12744 ! 12745 !-- Read data at the northern boundary 12746 CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_north_aerosol', & 12747 salsa_nest_offl%nconc_north, & 12748 MERGE( 0, 1, bc_dirichlet_n ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_n ), & 12749 MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ), & 12750 MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ), & 12751 MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_n ), & 12752 MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) ) 12753 IF ( bc_dirichlet_n ) THEN 12754 salsa_nest_offl%nconc_north = MAX( nclim, salsa_nest_offl%nconc_north ) 12755 CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, & 12756 nxr, 'ls_forcing_north_mass_fracs_a', 3 ) 12757 ENDIF 12758 IF ( .NOT. salsa_gases_from_chem ) THEN 12759 DO ig = 1, ngases_salsa 12760 vname = salsa_nest_offl%char_n // salsa_nest_offl%gas_name(ig) 12761 CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), & 12762 salsa_nest_offl%gconc_north(:,:,:,ig), & 12763 MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ), & 12764 MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ), & 12765 MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_n ), & 12766 MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) ) 12767 IF ( bc_dirichlet_n ) salsa_nest_offl%gconc_north(:,:,:,ig) = & 12768 MAX( nclim, salsa_nest_offl%gconc_north(:,:,:,ig) ) 12769 ENDDO 12770 ENDIF 12771 ! 12772 !-- Read data at the southern boundary 12773 CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_south_aerosol', & 12774 salsa_nest_offl%nconc_south, & 12775 MERGE( 0, 1, bc_dirichlet_s ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_s ), & 12776 MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ), & 12777 MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ), & 12778 MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_s ), & 12779 MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) ) 12780 IF ( bc_dirichlet_s ) THEN 12781 salsa_nest_offl%nconc_south = MAX( nclim, salsa_nest_offl%nconc_south ) 12782 CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, & 12783 nxr, 'ls_forcing_south_mass_fracs_a', 4 ) 12784 ENDIF 12785 IF ( .NOT. salsa_gases_from_chem ) THEN 12786 DO ig = 1, ngases_salsa 12787 vname = salsa_nest_offl%char_s // salsa_nest_offl%gas_name(ig) 12788 CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), & 12789 salsa_nest_offl%gconc_south(:,:,:,ig), & 12790 MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ), & 12791 MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ), & 12792 MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_s ), & 12793 MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) ) 12794 IF ( bc_dirichlet_s ) salsa_nest_offl%gconc_south(:,:,:,ig) = & 12795 MAX( nclim, salsa_nest_offl%gconc_south(:,:,:,ig) ) 12796 ENDDO 12797 ENDIF 12798 ! 12799 !-- Read data at the top boundary 12800 CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_top_aerosol', & 12801 salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol), & 12802 0, nbins_aerosol-1, nxl, nxr, nys, nyn, salsa_nest_offl%tind, & 12803 salsa_nest_offl%tind_p ) 12804 salsa_nest_offl%nconc_top = MAX( nclim, salsa_nest_offl%nconc_top ) 12805 CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nys, nyn, nxl, nxr, & 12806 'ls_forcing_top_mass_fracs_a', 5 ) 12807 IF ( .NOT. salsa_gases_from_chem ) THEN 12808 DO ig = 1, ngases_salsa 12809 vname = salsa_nest_offl%char_t // salsa_nest_offl%gas_name(ig) 12810 CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), & 12811 salsa_nest_offl%gconc_top(:,:,:,ig), nxl, nxr, nys, nyn, & 12812 salsa_nest_offl%tind, salsa_nest_offl%tind_p ) 12813 salsa_nest_offl%gconc_top(:,:,:,ig) = MAX( nclim, salsa_nest_offl%gconc_top(:,:,:,ig) ) 12814 ENDDO 12815 ENDIF 12816 ! 12817 !-- Close input file 12818 CALL close_input_file( salsa_nest_offl%id_dynamic ) 12819 12820 #endif 12821 ! 12822 !-- Set control flag to indicate that initialization is already done 12823 salsa_nest_offl%init = .TRUE. 12824 12825 END SUBROUTINE salsa_nesting_offl_input 12826 12827 !------------------------------------------------------------------------------! 12828 ! Description: 12829 ! ------------ 12830 !> Sets the mass concentrations to aerosol arrays in 2a and 2b. 12831 !------------------------------------------------------------------------------! 12832 SUBROUTINE nesting_offl_aero_mass( ts, te, ks, ke, is, ie, varname_a, ibound ) 12833 12834 USE netcdf_data_input_mod, & 12835 ONLY: get_variable 12836 12837 IMPLICIT NONE 12838 12839 CHARACTER(LEN=25) :: varname_b !< name for bins b 12840 12841 CHARACTER(LEN=*), INTENT(in) :: varname_a !< name for bins a 12842 12843 INTEGER(iwp) :: ee !< loop index: end 12844 INTEGER(iwp) :: i !< loop index 12845 INTEGER(iwp) :: ib !< loop index 12846 INTEGER(iwp) :: ic !< loop index 12847 INTEGER(iwp) :: k !< loop index 12848 INTEGER(iwp) :: ss !< loop index: start 12849 INTEGER(iwp) :: t !< loop index 12850 INTEGER(iwp) :: type_so4_oc = -1 !< 12851 12852 INTEGER(iwp), INTENT(in) :: ibound !< index: 1=left, 2=right, 3=north, 4=south, 5=top 12853 INTEGER(iwp), INTENT(in) :: ie !< loop index 12854 INTEGER(iwp), INTENT(in) :: is !< loop index 12855 INTEGER(iwp), INTENT(in) :: ks !< loop index 12856 INTEGER(iwp), INTENT(in) :: ke !< loop index 12857 INTEGER(iwp), INTENT(in) :: ts !< loop index 12858 INTEGER(iwp), INTENT(in) :: te !< loop index 12859 12860 INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !< 12861 12862 REAL(wp) :: pmf1a !< mass fraction in 1a 12863 12864 REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle 12865 12866 REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol) :: to_nconc !< 12867 REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol*ncomponents_mass) :: to_mconc !< 12868 12869 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mf2a !< Mass distributions for a 12870 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mf2b !< and b bins 12871 12872 ! 12873 !-- Variable name for insoluble mass fraction 12874 varname_b = varname_a(1:LEN( TRIM( varname_a ) ) - 1 ) // 'b' 12875 ! 12876 !-- Bin mean aerosol particle volume (m3) 12877 core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3 12878 ! 12879 !-- Allocate and read mass fraction arrays 12880 ALLOCATE( mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), & 12881 mf2b(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc) ) 12882 IF ( ibound == 5 ) THEN 12883 CALL get_variable( salsa_nest_offl%id_dynamic, varname_a, & 12884 mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1, & 12885 is, ie, ks, ke, ts, te ) 12886 ELSE 12887 CALL get_variable( salsa_nest_offl%id_dynamic, varname_a, & 12888 mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1, & 12889 is, ie, ks-1, ke-1, ts, te ) 12890 ENDIF 12891 ! 12892 !-- If the chemical component is not activated, set its mass fraction to 0 to avoid mass inbalance 12893 cc_i2m = salsa_nest_offl%cc_in2mod 12894 IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) mf2a(:,:,:,cc_i2m(1)) = 0.0_wp 12895 IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) mf2a(:,:,:,cc_i2m(2)) = 0.0_wp 12896 IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) mf2a(:,:,:,cc_i2m(3)) = 0.0_wp 12897 IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) mf2a(:,:,:,cc_i2m(4)) = 0.0_wp 12898 IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) mf2a(:,:,:,cc_i2m(5)) = 0.0_wp 12899 IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) mf2a(:,:,:,cc_i2m(6)) = 0.0_wp 12900 IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) mf2a(:,:,:,cc_i2m(7)) = 0.0_wp 12901 mf2b = 0.0_wp 12902 ! 12903 !-- Initialise variable type_so4_oc to indicate whether SO4 and/OC is included in mass fraction data 12904 IF ( ( cc_i2m(1) > 0 .AND. index_so4 > 0 ) .AND. ( cc_i2m(2) > 0 .AND. index_oc > 0 ) ) & 12905 THEN 12906 type_so4_oc = 1 12907 ELSEIF ( cc_i2m(1) > 0 .AND. index_so4 > 0 ) THEN 12908 type_so4_oc = 2 12909 ELSEIF ( cc_i2m(2) > 0 .AND. index_oc > 0 ) THEN 12910 type_so4_oc = 3 12911 ENDIF 12912 12913 SELECT CASE ( ibound ) 12914 CASE( 1 ) 12915 to_nconc = salsa_nest_offl%nconc_left 12916 to_mconc = salsa_nest_offl%mconc_left 12917 CASE( 2 ) 12918 to_nconc = salsa_nest_offl%nconc_right 12919 to_mconc = salsa_nest_offl%mconc_right 12920 CASE( 3 ) 12921 to_nconc = salsa_nest_offl%nconc_north 12922 to_mconc = salsa_nest_offl%mconc_north 12923 CASE( 4 ) 12924 to_nconc = salsa_nest_offl%nconc_south 12925 to_mconc = salsa_nest_offl%mconc_south 12926 CASE( 5 ) 12927 to_nconc = salsa_nest_offl%nconc_top 12928 to_mconc = salsa_nest_offl%mconc_top 12929 END SELECT 12930 ! 12931 !-- Set mass concentrations: 12932 ! 12933 !-- Regime 1: 12934 SELECT CASE ( type_so4_oc ) 12935 CASE ( 1 ) ! Both SO4 and OC given 12936 12937 ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a ! start 12938 ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a ! end 12939 ib = start_subrange_1a 12940 DO ic = ss, ee 12941 DO i = is, ie 12942 DO k = ks, ke 12943 DO t = 0, 1 12944 pmf1a = mf2a(t,k,i,cc_i2m(1)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) ) 12945 to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhoh2so4 12946 ENDDO 12947 ENDDO 12948 ENDDO 12949 ib = ib + 1 12950 ENDDO 12951 ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start 12952 ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a ! end 12953 ib = start_subrange_1a 12954 DO ic = ss, ee 12955 DO i = is, ie 12956 DO k = ks, ke 12957 DO t = 0, 1 12958 pmf1a = mf2a(t,k,i,cc_i2m(2)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) ) 12959 to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhooc 12960 ENDDO 12961 ENDDO 12962 ENDDO 12963 ib = ib + 1 12964 ENDDO 12965 CASE ( 2 ) ! Only SO4 12966 ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a ! start 12967 ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a ! end 12968 ib = start_subrange_1a 12969 DO ic = ss, ee 12970 DO i = is, ie 12971 DO k = ks, ke 12972 DO t = 0, 1 12973 to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhoh2so4 12974 ENDDO 12975 ENDDO 12976 ENDDO 12977 ib = ib + 1 12978 ENDDO 12979 CASE ( 3 ) ! Only OC 12980 ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start 12981 ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a ! end 12982 ib = start_subrange_1a 12983 DO ic = ss, ee 12984 DO i = is, ie 12985 DO k = ks, ke 12986 DO t = 0, 1 12987 to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhooc 12988 ENDDO 12989 ENDDO 12990 ENDDO 12991 ib = ib + 1 12992 ENDDO 12993 END SELECT 12994 ! 12995 !-- Regimes 2a and 2b: 12996 IF ( index_so4 > 0 ) THEN 12997 CALL set_nest_mass( index_so4, 1, arhoh2so4 ) 12998 ENDIF 12999 IF ( index_oc > 0 ) THEN 13000 CALL set_nest_mass( index_oc, 2, arhooc ) 13001 ENDIF 13002 IF ( index_bc > 0 ) THEN 13003 CALL set_nest_mass( index_bc, 3, arhobc ) 13004 ENDIF 13005 IF ( index_du > 0 ) THEN 13006 CALL set_nest_mass( index_du, 4, arhodu ) 13007 ENDIF 13008 IF ( index_ss > 0 ) THEN 13009 CALL set_nest_mass( index_ss, 5, arhoss ) 13010 ENDIF 13011 IF ( index_no > 0 ) THEN 13012 CALL set_nest_mass( index_no, 6, arhohno3 ) 13013 ENDIF 13014 IF ( index_nh > 0 ) THEN 13015 CALL set_nest_mass( index_nh, 7, arhonh3 ) 13016 ENDIF 13017 13018 DEALLOCATE( mf2a, mf2b ) 13019 13020 SELECT CASE ( ibound ) 13021 CASE( 1 ) 13022 salsa_nest_offl%mconc_left = to_mconc 13023 CASE( 2 ) 13024 salsa_nest_offl%mconc_right = to_mconc 13025 CASE( 3 ) 13026 salsa_nest_offl%mconc_north = to_mconc 13027 CASE( 4 ) 13028 salsa_nest_offl%mconc_south = to_mconc 13029 CASE( 5 ) 13030 salsa_nest_offl%mconc_top = to_mconc 13031 END SELECT 13032 13033 CONTAINS 13034 13035 !------------------------------------------------------------------------------! 13036 ! Description: 13037 ! ------------ 13038 !> Set nesting boundaries for aerosol mass. 13039 !------------------------------------------------------------------------------! 13040 SUBROUTINE set_nest_mass( ispec, ispec_def, prho ) 13041 13042 IMPLICIT NONE 13043 13044 INTEGER(iwp) :: ic !< chemical component index: default 13045 INTEGER(iwp) :: icc !< loop index: mass bin 13046 13047 INTEGER(iwp), INTENT(in) :: ispec !< aerosol species index 13048 INTEGER(iwp), INTENT(in) :: ispec_def !< default aerosol species index 13049 13050 REAL(wp), INTENT(in) :: prho !< aerosol density 13051 ! 13052 !-- Define the index of the chemical component in the input data 13053 ic = salsa_nest_offl%cc_in2mod(ispec_def) 13054 13055 DO i = is, ie 13056 DO k = ks, ke 13057 DO t = 0, 1 13058 ! 13059 !-- Regime 2a: 13060 ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a 13061 ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a 13062 ib = start_subrange_2a 13063 DO icc = ss, ee 13064 to_mconc(t,k,i,icc) = MAX( 0.0_wp, mf2a(t,k,i,ic) / SUM( mf2a(t,k,i,:) ) ) * & 13065 to_nconc(t,k,i,ib) * core(ib) * prho 13066 ib = ib + 1 13067 ENDDO 13068 ! 13069 !-- Regime 2b: 13070 IF ( .NOT. no_insoluble ) THEN 13071 ! 13072 !-- TODO! 13073 mf2b(t,k,i,ic) = mf2b(t,k,i,ic) 13074 ENDIF 13075 ENDDO ! k 13076 13077 ENDDO ! j 13078 ENDDO ! i 13079 13080 END SUBROUTINE set_nest_mass 13081 13082 END SUBROUTINE nesting_offl_aero_mass 13083 13084 11969 13085 END MODULE salsa_mod
Note: See TracChangeset
for help on using the changeset viewer.
